home *** CD-ROM | disk | FTP | other *** search
/ Aminet 40 / Aminet 40 (2000)(Schatztruhe)[!][Dec 2000].iso / Aminet / util / rexx / FWCalendar.lha / FWCalendar / FWCAddEvent.rexx next >
OS/2 REXX Batch file  |  2000-10-23  |  97KB  |  2,688 lines
  1. /*
  2.     AddEvent.rexx Macro
  3.     Adds events to calendars created by FWCalendar.rexx
  4.     $VER: FWCAddEvent.rexx v3.91 (7 Oct 2000)
  5.     ©Ron Goertz (goertz@earthlink.net)
  6. */
  7. OPTIONS RESULTS
  8. signal on syntax
  9. options failat 11
  10. Numeric Digits 14
  11.  
  12. parse source . . . FullCallPath . CallHost
  13. CallHost = strip(CallHost)
  14. ScriptDir = PathPart(FullCallPath)
  15.  
  16. CurrentDir = Pragma('D')
  17. if right(CurrentDir, 1) ~= ':' then CurrentDir = CurrentDir'/'
  18.  
  19. call AddLibraries
  20. if ClassAct == 0 then bguiopen = bguiopen()
  21. if ErrorCount > 0 then call Cleanup
  22.  
  23. address value DetermineHost()
  24. call SetVariables
  25.  
  26. Month = substr(TempDate,5,2) - 0
  27. PrevMonth = Month - 1
  28. if PrevMonth = 0 then PrevMonth = 12
  29. NextMonth = Month + 1
  30. if NextMonth = 13 then NextMonth = 1
  31.  
  32. Year = left(TempDate,4)
  33. if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then MonthLength.2  = 29
  34.  
  35. interpret "StartDate = Day."Date('W', TempDate, 'S')
  36. if (DoExtended == 0) | (StartDate + MonthLength.Month > 35) then MaxDate = MonthLength.Month
  37. else MaxDate = 35 - StartDate
  38.  
  39. FontName = Font.Highlight
  40. FontSize = FSize.Highlight
  41. if ClassAct == 1 then call GetEvent_CA
  42. else call GetEvent_BGUI
  43. exit
  44.  
  45. /*********************************************/
  46. /*              Subroutines                  */
  47. /*********************************************/
  48. /***//*** AddBGUI (AB) ***/
  49. AddBGUI:
  50.   i = 0; AL_RexxBGUILib = i; AL_Lib.i = 'rexxbgui.library';    AL_MinVersion.i = 4;     AL_Offset.i = -30;  AL_Variable.i = 'RexxBGUILib'; AL_Status.i = "E"
  51.   i = 1; AL_BGUILib = i;     AL_Lib.i = 'bgui.library';        AL_MinVersion.i = 41.1;  AL_Offset.i = '' ;  AL_Variable.i = 'BGUILib';     AL_Status.i = "E"
  52.  
  53.   do i = 0 to 1
  54.     if exists('LIBS:'AL_lib.i) then do
  55.       AL_InstalledVersion = PgmVer('LIBS:'AL_lib.i)
  56.       AL_LibCount = AL_LibCount + 1
  57.       Library.Name.AL_LibCount = AL_Lib.i
  58.       Library.Version.AL_LibCount = AL_InstalledVersion
  59.       if (AL_InstalledVersion < AL_MinVersion.i) | (AL_InstalledVersion == '') then do
  60.         call AddMsg(AL_Status.i, AL_Lib.i' version 'AL_MinVersion.i' is required; your version is 'AL_InstalledVersion'.')
  61.         interpret Al_Variable.i' = 0'
  62.       end
  63.       else do
  64.         if i ~= AL_BGUILib then call addlib(AL_lib.i, 0, AL_Offset.i, trunc(AL_MinVersion.i))
  65.         interpret Al_Variable.i' = 1'
  66.       end
  67.     end
  68.     else do
  69.       interpret Al_Variable.i' = 0'
  70.       if (i = AL_RexxBGUILib) | (i = AL_BGUILib) then do
  71.         if GUIWarning == 0 then do
  72.           GUIWarning = 1
  73.           call AddMsg('E', 'Either the ClassAct files or the BGUI files (see the docs)')
  74.           call AddMsg('E', '  must be installed. Neither could be found...')
  75.         end
  76.       end
  77.       else if AL_Status.i == 'E' then call AddMsg('E', AL_lib.i' is required but could not be found.')
  78.     end
  79.   end
  80.   if RexxBGUILib == 1 then ClassAct = 0
  81.   if (ClassAct == 0) & (bguiopen = 0) then bguiopen = bguiopen()
  82.  
  83.   return
  84. /**/
  85.  
  86. /***//*** AddLibraries (AL) ***/
  87. AddLibraries:
  88.   AL_LibCount     = 0
  89.   DoingCleanup    = 0
  90.   PortList        = show('P')
  91.   ErrorCount      = 0
  92.   HostScreen      = ''
  93.   WarningCount    = 0
  94.   Req             = 0
  95.   bguiopen        = 0
  96.   Storage         = 'RAM:FWC/'
  97.   ClassAct        = 0
  98.   ForceBGUI       = 0
  99.   ReqCAVersion    = 44.569
  100.   ReqAPVersion    = 2.48
  101.   ReqCAVersion    = 42.8
  102.   ClassActMessage = ''
  103.   AWNPipeMessage  = ''
  104.   GUIWarning      = 0
  105.  
  106.   call TranslationStrings
  107.   interpret ReadFile(ScriptDir'FWCTranslations.txt')
  108.  
  109.   i = 0; AL_DateLib = i;     AL_Lib.i = 'date.library';        AL_MinVersion.i = 33.31; AL_Offset.i = -492; AL_Variable.i = 'DateLib';     AL_Status.i = "W"
  110.   i = 1; AL_RexxMathLib = i; AL_Lib.i = 'rexxmathlib.library'; AL_MinVersion.i = 38.1;  AL_Offset.i = -30;  AL_Variable.i = 'RexxMathLib'; AL_Status.i = "W"
  111.  
  112.   if (exists('L:awnpipe-handler')) then do
  113.     if (exists('LIBS:gadgets/layout.gadget')) then do
  114.     ClassActVersion = PgmVer('LIBS:gadgets/layout.gadget')
  115.     AWNPipeVersion  = PgmVer('L:awnpipe-handler')
  116.     if ClassActVersion < ReqCAVersion then do
  117.       ClassActMessage = 'ClassAct version 'ReqCAVersion'+ is required; your version is 'ClassActVersion'. BGUI is being used'
  118.       ForceBGUI = 1
  119.     end
  120.     if AWNPipeVersion < ReqAPVersion then do
  121.       AWNPipeMessage = 'AWNPipe version 'ReqAPVersion'+ is required; your version is 'AWNPipeVersion'. BGUI is being used'
  122.       ForceBGUI = 1
  123.     end
  124.     if ForceBGUI == 0 then ClassAct = 1
  125.   end
  126.   if ForceBGUI == 1 then ClassAct = 0
  127.  
  128.   do i = 0 to 1
  129.     if exists('LIBS:'AL_lib.i) then do
  130.       AL_InstalledVersion = PgmVer('LIBS:'AL_lib.i)
  131.       AL_LibCount = AL_LibCount + 1
  132.       Library.Name.AL_LibCount = AL_Lib.i
  133.       Library.Version.AL_LibCount = AL_InstalledVersion
  134. if (i == AL_RexxMathLib) & (AL_InstalledVersion == '38.02') then AL_InstalledVersion = 38.2
  135.       if (AL_InstalledVersion < AL_MinVersion.i) | (AL_InstalledVersion == '') then do
  136.         call AddMsg(AL_Status.i, AL_Lib.i' version 'AL_MinVersion.i' is required; your version is 'AL_InstalledVersion'.')
  137.         interpret Al_Variable.i' = 0'
  138.       end
  139.       else do
  140.         call addlib(AL_lib.i, 0, AL_Offset.i, trunc(AL_MinVersion.i))
  141.         interpret Al_Variable.i' = 1'
  142.       end
  143.     end
  144.     else do
  145.       interpret Al_Variable.i' = 0'
  146.       if AL_Status.i == 'E' then call AddMsg('E', AL_lib.i' is required but could not be found.')
  147.     end
  148.   end
  149.   if (DateLib == 1) | (RexxMathLib == 1) then PhaseLib = 1
  150.   else PhaseLib = 0
  151.  
  152.   if ForceBGUI == 1 then call AddBGUI
  153.  
  154.   if ErrorCount > 0 then call Cleanup
  155.   return
  156. /**/
  157.  
  158. /***//*** AddMsg (AM) Subroutine ***/
  159. AddMsg:
  160.   parse arg AM_MsgType, AM_Msg
  161.  
  162.   if AM_MsgType == 'E' then do
  163.     ErrorCount = ErrorCount + 1
  164.     Error.ErrorCount = AM_Msg
  165.   end
  166.   else do
  167.     WarningCount = WarningCount + 1
  168.     Warning.WarningCount = AM_Msg
  169.   end
  170.  
  171.   return
  172. /**/
  173.  
  174. /***//*** AssignID (AID) ***/
  175. AssignID:
  176.   parse arg AID_Var, AID_ID
  177.  
  178.   interpret AID_Var' = 'AID_ID
  179.   GE_Gad.AID_ID = AID_Var
  180.   if left(AID_Var, 5) = 'GadID' then AID_Var = 'GadID'
  181.   GE_Help.AID_ID = AID_Var'Help'
  182.  
  183.   return
  184. /**/
  185.  
  186. /***//*** BusyReq (BR) ***/
  187. /*** OpenBusy ***/
  188. OpenBusy:
  189.   parse arg BR_BusyTitle, BR_EventCount
  190.   BR_Progress = 0
  191.   if ClassAct == 1 then do
  192.     call open('ProgReq', "awnpipe:ProgressReq/xc")
  193.     call ToPIPE('ProgReq', 'm v cs si so a ps="'AppScreen'"')
  194.     call ToPIPE('ProgReq', 'label gt="'BR_BusyTitle', 'PleaseWait$'..."')
  195.     BR_ProgressGad = ToPIPE('ProgReq', 'fuelgauge defn=0 maxn='BR_EventCount' t=0 per')
  196.     call ToPIPE('ProgReq', 'layout b=0 si so cj')
  197.       call ToPIPE('ProgReq', 'space')
  198.       BR_CancelGad = ToPIPE('ProgReq', 'button pb gt="'Cancel$'"')
  199.       call ToPIPE('ProgReq', 'space')
  200.     call ToPIPE('ProgReq', 'le')
  201.     if ToPIPE('ProgReq', 'open') == 'window' then BR_ProgressWindow = 1
  202.     else BR_ProgressWindow = 0
  203.   end
  204.   else do
  205.     BR_ProgressGroup=bguivgroup(,
  206.           bguiinfo('BR_dummy',,'1B'x||'c'BR_BusyTitle', 'PleaseWait$'...')bguilayout(LGO_FixMinHeight,1)||,
  207.           bguiprogress('BR_prog2_',,0,BR_EventCount)||,
  208.           bguihgroup(,
  209.                   bguivarspace(50)bguilayout(LGO_FixMinHeight,1)||,
  210.                   bguibutton('BR_cancel_',Cancel$)bguilayout(LGO_FixMinHeight,1)||,
  211.                   bguivarspace(50)bguilayout(LGO_FixMinHeight,1),
  212.           ,,,,'W'),
  213.     ,-2,-2)
  214.     BR_ProgressWindow = bguiwindow('',BR_ProgressGroup,,2,,AppScreen)
  215.     if bguiwinopen(BR_ProgressWindow) = 0 then call Cleanup
  216.   end
  217.  
  218.   return BR_ProgressWindow
  219.  
  220. /*** UpdateBusy ***/
  221. UpdateBusy:
  222.   parse arg BR_ReqWin, BR_ProgressMade
  223.  
  224.   if BR_ReqWin == 0 then return 0
  225.   BR_Progress = BR_Progress + BR_ProgressMade
  226. /* say '>'BR_Progress SIGL */
  227.   if ClassAct == 1 then do
  228.     if show('F', 'ProgReq') == 1 then do
  229.       call writeln('ProgReq', 'id 'BR_CancelGad' read')
  230.       BR_CancelStatus = readln('ProgReq')
  231.       if BR_CancelStatus == 1 then do
  232.         call close('ProgReq')
  233.         return -1
  234.       end
  235.     end
  236.     else return 0
  237.     if show('F', 'ProgReq') == 1 then do
  238.       call ToPIPE('ProgReq', 'id 0 s=2')
  239.       call writeln('ProgReq', 'id 'BR_ProgressGad' defn='BR_Progress' ref')
  240.       call readln('ProgReq')
  241.     end
  242.     else return 0
  243.   end
  244.   else do
  245.     call bguiset(obj.BR_prog2_,BR_ReqWin,PROGRESS_Done,BR_Progress)
  246.     if bguiwinevent(BR_ReqWin,'ID') == id.BR_cancel_ then return -1
  247.   end
  248.  
  249.   return BR_Progress
  250.  
  251. /*** CloseBusy ***/
  252. CloseBusy:
  253.   parse arg BR_ReqWin
  254.  
  255.   if BR_ReqWin == 0 then return 0
  256.  
  257.   if ClassAct == 1 then call close('ProgReq')
  258.   else call bguiwinclose(BR_ReqWin)
  259.   Req = 0
  260.  
  261.   return 0
  262. /**/
  263.  
  264. /***//*** CAGetFile (GF) ***/
  265. CAGetFile:
  266.   parse arg GF_FileHandle, GF_GadID, GF_Title, GF_InitDir
  267.  
  268.   call writeln(GF_FileHandle,'id 'GF_GadID' gt="'GF_Title':" fn="'GF_InitDir'" s=1')
  269.   GF_GetFileResult = readln(GF_FileHandle)
  270.   parse var GF_GetFileResult GF_OK GF_Choice GF_File
  271.   if GF_Choice ~= 0 then GF_File = strip(GF_File, 'B', '" ')
  272.   else GF_File = ''
  273.  
  274.   return GF_File
  275. /**/
  276.  
  277. /***//*** CASimpleReq (CAS) ***/
  278. CASimpleReq:
  279.   parse arg CAS_Title, CAS_Msg, CAS_Time
  280.  
  281.   if CAS_Time == '' then do
  282.     CAS_Msg = translate(CAS_Msg, "'", '"')
  283.     do while pos('0a'x, CAS_Msg) > 0
  284.       CAS_Msg = left(CAS_Msg, pos('0a'x, CAS_Msg) - 1)'*n'substr(CAS_Msg, pos('0a'x, CAS_Msg) + 1)
  285.     end
  286.  
  287.     call open('Req', "awnpipe:SimpleReq/xc")
  288.     call ToPIPE('Req', '"'CAS_Title'" v db dg si so a ps="'AppScreen'"')
  289.     call ToPIPE('Req', 'label gt="'CAS_Msg'"')
  290.     call ToPIPE('Req', 'layout b=0 si so cj')
  291.       call ToPIPE('Req', 'space')
  292.       call ToPIPE('Req', 'button c gt="'OK$'"')
  293.       call ToPIPE('Req', 'space')
  294.     call ToPIPE('Req', 'le')
  295.     call ToPIPE('Req', 'open')
  296.  
  297.     do while ~eof('Req')
  298.       call readln('Req')
  299.     end
  300.     call close('Req')
  301.   end
  302.   else do
  303.     call open('Req', "awnpipe:SimpleReq/xc")
  304.     call ToPIPE('Req', 'm sk si so a ps="'AppScreen'"')
  305.     call ToPIPE('Req', 'label gt="'CAS_Msg'"')
  306.     call ToPIPE('Req', 'open')
  307.  
  308.     CAS_TickCount = 0
  309.     do until CAS_TickCount >= CAS_Time
  310.       call ToPIPE('Req', 'tick 100')
  311.       Req_EventInfo = readln('Req')
  312.       parse var Req_EventInfo Req_Event' 'Req_GadID' 'Req_GadInfo1
  313.       select
  314.         when Req_Event == 'key' then CAS_TickCount = CAS_Time
  315.         when Req_Event = 'tick' then CAS_TickCount = CAS_TickCount + 1
  316.         otherwise nop
  317.       end
  318.     end
  319.     call close('Req')
  320.   end
  321.  
  322.   return
  323. /**/
  324.  
  325. /***//*** Cleanup () Subroutine ***/
  326. Cleanup:
  327.   signal off syntax
  328.  
  329.   if VariablesSet == 1 then do
  330.     interpret UserPrefs
  331.     call CloseBusy(Req)
  332.     if App == 'FW' then do
  333.       SELECTOBJECT
  334.       REDRAW
  335.       if upper(DecimalFormat) == 'COMMA' then DocItemPrefs Decimal Comma
  336.     end
  337.     else if App == 'PGS' then do
  338.       SELECTOBJECT None WINDOW winName
  339.       if WindowRefreshed ~= 1 then do
  340.         REFRESH ON
  341.         REFRESHWINDOW WINDOW winName
  342.       end
  343.     end
  344.   end
  345.  
  346.   LogOpen = open('FWCLog', Storage'FWCLog.txt', 'W')
  347.   if LogOpen == 0 then do
  348.     address command 'makedir >NIL: 'left(Storage, length(Storage) - 1)
  349.     LogOpen = open('FWCLog', Storage'FWCLog.txt', 'W')
  350.   end
  351.   if LogOpen == 1 then OutType = 'File'
  352.   if ((WarningCount > 0) | (ErrorCount > 0)) & (LogOpen == 0) then do
  353.     LogOpen = 1
  354.     call open('FWCLog', 'CON:10/10/500/300/FWCalendar.rexx Message/WAIT/CLOSE')
  355.     OutType = 'CON'
  356.   end
  357.  
  358.   if LogOpen == 1 then do
  359.     call writeln('FWCLog', '      Macro: 'strip(substr(sourceline(4), pos(':', sourceline(4)) + 1)))
  360.     call writeln('FWCLog', 'Application: 'PgmVersion)
  361.     call writeln('FWCLog', 'Current Dir: 'CurrentDir)
  362.     call writeln('FWCLog', ' Script Dir: 'ScriptDir)
  363.     call writeln('FWCLog', '       Host: 'CallHost)
  364.     call writeln('FWCLog', '   Calendar: 'Month.Month' 'Year||'0a'x)
  365.   end
  366.  
  367.   if (ErrorCount > 0) | (WarningCount > 0) then do
  368.     do i = 1 to ErrorCount
  369.       call writeln('FWCLog', Error.i)
  370.     end
  371.  
  372.     do i = 1 to WarningCount
  373.       call writeln('FWCLog', Warning.i)
  374.     end
  375.  
  376.     if (PrefsFile ~= '') & (exists(PrefsFile)) then do
  377.       call writeln('FWCLog', '0a'x||' -- 'PrefsFile' -- ')
  378.       call open('DataFile', PrefsFile)
  379.         do until eof('DataFile')
  380.           Ln = ReadLn('DataFile')
  381.           if pos('End Pass One', Ln) > 0 then leave
  382.           call writeln('FWCLog', Ln)
  383.         end
  384.       call close('DataFile')
  385.     end
  386.  
  387.     if (EventFile ~= '') & (symbol('EventFile') == 'VAR') then do
  388.       call writeln('FWCLog', '0a'x||' -- 'EventFile' -- ')
  389.       call open('DataFile', EventFile)
  390.         do while ~eof('DataFile')
  391.           if ~eof('DataFile') then call writeln('FWCLog', ReadLn('DataFile'))
  392.         end
  393.       call close('DataFile')
  394.     end
  395.  
  396.     if ErrorCount > 0 then ErrorType = Critical$
  397.     else ErrorType = Noncritical$
  398.     FileMsg = ErrorType' ... 'See$' 'Storage'FWCLog.txt 'ForDetails$'.'||'0a'x||ForwardLog$': Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
  399.     Conbgui = ErrorType' ... 'SeeShell$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
  400.     ConCon  = ErrorType' ... 'SeeOutput$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
  401.  
  402.     if (OutType == 'File') & (ClassAct == 1) then call CASimpleReq('FWCalendar 'Notice$, FileMsg)
  403.     if (OutType == 'File') & (bguiopen == 1) then call bguireq('1B'x||'c'FileMsg,'*'OK$,'FWCalendar 'Notice$,,AppScreen)
  404.     if (OutType == 'File') & (bguiopen == 0) & (ClassAct == 0) then do
  405.       call open('CON', 'CON:10/10/500/300/FWCAddEvent notice/WAIT/CLOSE')
  406.         call writeln('CON', FileMsg)
  407.       call close('CON')
  408.     end
  409.  
  410.     if (OutType == 'CON') & (ClassAct == 1) then call CASimpleReq('FWCalendar 'Notice$, Conbgui)
  411.     if (OutType == 'CON') & (bguiopen == 1) then call bguireq('1B'x||'c'Conbgui,'*'OK$,'FWCalendar 'Notice$,,AppScreen)
  412.     if (OutType == 'CON') & (bguiopen == 0) & (ClassAct == 0) then call Writeln('FWCLog', '0a'x||ConCon)
  413.   end
  414.   else do
  415.     address command 'delete >NIL: 'Storage'FWC'App'Temp.txt quiet'
  416.     if LogOpen == 1 then call writeln('FWCLog', 'No errors.')
  417.   end
  418.  
  419.   address command 'delete >NIL: 'Storage'FWCTemp quiet'
  420.   call close('FWCLog')
  421.   if bguiopen = 1 then call bguiclose()
  422.   exit
  423. /**/
  424.  
  425. /***//*** ConvertDay (CD) Subroutine***/
  426. ConvertDay:
  427.   parse arg CD_Day
  428.   If upper(left(CD_Day,1)) == "P" then CD_Day = substr(CD_Day,2) - MonthLength.PrevMonth
  429.   If upper(left(CD_Day,1)) == "N" then CD_Day = substr(CD_Day,2) + MonthLength.Month
  430.   return CD_Day
  431. /**/
  432.  
  433. /***//*** DetermineHost () Subroutine ***/
  434. DetermineHost:
  435.   owner = ReadFile('ENV:Owner')
  436.   if (pos('FINALWRITER', upper(CurrentDir)) > 0) | (left(CallHost, 6) == 'FINALW') then do
  437.     App     = 'FW'
  438.     AppName = 'FINALWRITER'
  439.     if CallHost == 'REXX' then HostPort = substr(PortList, pos('FINALW.', PortList), 8)
  440.     else HostPort = CallHost
  441.     address value HostPort
  442.     GETDOCITEMPREFS Decimal; DecimalFormat = result
  443.     DOCITEMPREFS Decimal Period
  444.   end
  445.   else if (pos('PAGESTREAM', upper(CurrentDir)) > 0) | (CallHost == 'PAGESTREAM') then do
  446.     App     = 'PGS'
  447.     AppName = 'PAGESTREAM'
  448.     HostPort = 'PAGESTREAM'
  449.   end
  450.   else do
  451.     call AddMsg('E', 'Unable to determine host!')
  452.     call AddMsg('E', 'Make sure FWCAddEvent is called from Final Writer or PageStream')
  453.     call Cleanup
  454.   end
  455.  
  456.   PgmVersion = getclip('FWC'App'VersionInfo.txt')
  457.   if PgmVersion == '' then do
  458.     address command 'list >PIPE:FWC 'AppName'#? lformat %N'
  459.     ListOutput = ReadFile('PIPE:FWC')
  460.     call openv('ListOutput')
  461.       do while ~eofv('ListOutput')
  462.         PgmName = readvln('ListOutput')
  463.         if pos('.', PgmName) == 0 then leave
  464.       end
  465.     call closev('ListOutput')
  466.     address command 'version >PIPE:FWC 'PgmName
  467.     PgmVersion = ReadFile('PIPE:FWC')
  468.  
  469.     if left(PgmVersion, 34) == 'Could not find version information' then do
  470.       if App == 'FW' then do
  471.         call open('Temp', CurrentDir''PgmName)
  472.           /* Desired string at 325365 for v 5.06 */
  473.           /* Desired string at 333771 for FW97   */
  474.           FileOffset = 325300
  475.           call seek('Temp', FileOffset, 'B')
  476.           do until (EndPos ~= 0) | (PrevOffset = FileOffset)
  477.             PrevOffset = FileOffset
  478.             Chunk = readch('Temp', 10000)
  479.             EndPos = pos('Created', Chunk)
  480.             if EndPos == 0 then FileOffset = seek('Temp', -100, 'C')
  481.           end
  482.           if EndPos ~= 0 then do
  483.             StartPos = lastpos('Final', Chunk, EndPos)
  484.             EndPos = pos('00'x||'00'x, Chunk, StartPos)
  485.             PgmVersion = substr(Chunk, StartPos, EndPos - StartPos - 1)
  486.           end
  487.           else do
  488.             FileOffset = 0
  489.             call seek('Temp', FileOffset, 'B')
  490.             do until (EndPos ~= 0) | (PrevOffset = FileOffset)
  491.               PrevOffset = FileOffset
  492.               Chunk = readch('Temp', 10000)
  493.               EndPos = pos('FinalWriter 97', Chunk)
  494.               if EndPos == 0 then FileOffset = seek('Temp', -100, 'C')
  495.             end
  496.             if EndPos ~= 0 then PgmVersion = 'FinalWriter 97'
  497.             else PgmVersion = 'Final Writer - version unknown'
  498.           end
  499.         call close('Temp')
  500.       end
  501.       else if App == 'PGS' then do
  502.         PgmVersion = PgmName" - can't find version info"
  503.       end
  504.       call setclip('FWC'App'VersionInfo.txt', PgmVersion)
  505.     end
  506.   end
  507.  
  508.   AppScreen = ''
  509.   PubScreenApps = 'FrontPubScreen Publican MagicPubName'
  510.   do i = 1 to words(PubScreenApps)
  511.     interpret 'address command "'word(PubScreenApps, i)' >PIPE:FWC"'
  512.     if RC > 0 then iterate
  513.     AppScreen = readfile('PIPE:FWC')
  514.     if AppScreen ~= '' then leave
  515.   end
  516.  
  517.   return HostPort
  518. /**/
  519.  
  520. /***//*** DrawBox (DB) Subroutine ***/
  521. DrawBox:
  522.   parse arg DB_x1, DB_y1, DB_Width, DB_Height, DB_Weight, DB_Color, DB_FillBool, DB_FillColor, DB_Tint
  523.  
  524.   if DB_FillColor == '<'Clear$'>' then DB_FillBool = 0
  525.  
  526.   if App == 'FW' then do
  527.     if DB_Weight == 'HL' then DB_Weight = 'Hairline'
  528.     else if DB_Weight == 0 then do
  529.       DB_Weight = 'None'
  530.       if DB_FillColor ~= '<'Clear$'>' then DB_Color = DB_FillColor
  531.     end
  532.  
  533.     if DB_FillBool == 1 then DB_FillBool = 'Solid'
  534.     else do
  535.       DB_FillBool = 'Transparent'
  536.       DB_FillColor = DB_Color
  537.     end
  538.  
  539.     BOXPREFS LINEWT DB_Weight LINECOLOR '"'DB_Color'"' FILL DB_FillBool FILLCOLOR '"'DB_FillColor'"'
  540.     DRAWBOX 1 DB_x1 DB_y1 DB_Width DB_Height; DB_id = result
  541.   end
  542.   else if App == 'PGS' then do
  543.     if DB_Weight == 'HL' then DB_Weight = 0.3pt
  544.     else DB_Weight = DB_Weight'pt'
  545.  
  546.     if DB_FillBool == 1 then DB_FillBool = 'ON'
  547.     else DB_FillBool = 'OFF'
  548.  
  549.     If DB_Weight == 0 then DB_LineBool = 'OFF'
  550.     else DB_LineBool = 'ON'
  551.  
  552.     DRAWBOX DB_x1 DB_y1 DB_x1 + DB_Width DB_y1 + DB_Height WINDOW winName; DB_id = result
  553.     STROKED DB_LineBool OBJECTID DB_id WINDOW winName
  554.     SETSTROKEWEIGHT DB_Weight STROKENUMBER 0 OBJECTID DB_id WINDOW winName
  555.     SETCOLORSTYLE '"'DB_Color'"' COLORNUMBER 0 STROKENUMBER 0 OBJECTID DB_id WINDOW winName
  556.     FILLED DB_FillBool OBJECTID DB_id WINDOW winName
  557.     SETCOLORSTYLE '"'DB_FillColor'"' COLORNUMBER 0 FILL OBJECTID DB_id WINDOW winName
  558.     SETCOLORTINT DB_Tint FILL OBJECTID DB_id WINDOW winName
  559.   end
  560.   return DB_id
  561. /**/
  562.  
  563. /***//*** dTox (PROCEDURE) Subroutine ***/
  564. dTox:PROCEDURE
  565. parse arg DecVal
  566.  
  567. BinVal = ''
  568. HexVal = ''
  569. do i = 32 to 0 by -1
  570.   if DecVal >= 2**i then do
  571.     BinVal = BinVal'1'
  572.     DecVal = DecVal - 2**i
  573.   end
  574.   else BinVal = BinVal'0'
  575. end
  576.  
  577. do until BinVal == ''
  578.   HexVal = c2x(b2c(right(BinVal, 8, '0')))''HexVal
  579.   if length(BinVal) >= 8 then CutLength = 8
  580.   else CutLength = length(BinVal)
  581.   BinVal = left(BinVal, length(BinVal) - CutLength)
  582. end
  583.  
  584. return HexVal
  585. /**/
  586.  
  587. /***//*** GetEvent_BGUI (GE) Subroutine ***/
  588. GetEvent_BGUI:
  589.   do GE_i = 0 to 15
  590.     linelist_.GE_i = GE_i
  591.   end
  592.   linelist_.COUNT = min(RowsThatFit, 16)
  593.  
  594.   call bguilist("eventlist_",Event$,File$)
  595.   call bguilist("FrequencyList", Once$, Weekly$, Biweekly$)
  596.  
  597.   GE_StartOrEnd   = 1
  598.   GE_StartDate    = ""
  599.   GE_EndDate      = ""
  600.   GE_Boxed.0      = ""
  601.   GE_Boxed.128    = "B"
  602.   GE_Weekly.0     = ""
  603.   GE_Weekly.1     = "W"
  604.   GE_Weekly.2     = "2"
  605.   GadID.          = ''
  606.   GE_Arg.         = ''
  607.   GE_i            = 0
  608.   GE_Day          = 0
  609.   GE_PrevDay      = MonthLength.PrevMonth - StartDate
  610.   GE_NextDay      = 0
  611.  
  612.   Req = OpenBusy(PrepReq$, 45)
  613.   do while (GE_i < 6)
  614.     GE_j = 0
  615.     do while (GE_j < 7)
  616.       call UpdateBusy(Req, 1)
  617.       GE_SerialPosition = (GE_i * 7) + GE_j
  618.       GE_Button = GE_SerialPosition + 1
  619.       if (GE_SerialPosition >= StartDate) & (GE_SerialPosition < StartDate + MonthLength.Month) then Do
  620.         GE_Day = GE_Day + 1
  621.         interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_Day)"
  622.         GadID = GetID(GE_Button'_')
  623.         GE_Arg.GadID = 'C 'left(Month.Month, 3)' 'GE_Day
  624.       end
  625.       else do
  626.         if GE_SerialPosition < StartDate then Do
  627.           GE_PrevDay = GE_PrevDay + 1
  628.           interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_PrevDay)"
  629.           GadID = GetID(GE_Button'_')
  630.           GE_Arg.GadID = 'P 'left(Month.PrevMonth, 3)' 'GE_PrevDay
  631.         end
  632.         else do
  633.           GE_NextDay = GE_NextDay + 1
  634.           interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_NextDay)"
  635.           GadID = GetID(GE_Button'_')
  636.           GE_Arg.GadID = 'N 'left(Month.NextMonth, 3)' 'GE_NextDay
  637.         end
  638.       end
  639.       GE_j = GE_j + 1
  640.     end
  641.     GE_i = GE_i + 1
  642.     if GE_SerialPosition >= StartDate + MonthLength.Month - 1 then leave
  643.   end
  644.  
  645.   DateButtons = bguihgroup(GadID.1""GadID.2""GadID.3""GadID.4""GadID.5""GadID.6""GadID.7)||,
  646.                 bguihgroup(GadID.8""GadID.9""GadID.10""GadID.11""GadID.12""GadID.13""GadID.14)||,
  647.                 bguihgroup(GadID.15""GadID.16""GadID.17""GadID.18""GadID.19""GadID.20""GadID.21)||,
  648.                 bguihgroup(GadID.22""GadID.23""GadID.24""GadID.25""GadID.26""GadID.27""GadID.28)
  649.   if GE_i > 4 then DateButtons = DateButtons''bguihgroup(GadID.29""GadID.30""GadID.31""GadID.32""GadID.33""GadID.34""GadID.35)
  650.   if GE_i > 5 then DateButtons = DateButtons''bguihgroup(GadID.36""GadID.37""GadID.38""GadID.39""GadID.40""GadID.41""GadID.42)
  651.  
  652.   g=bguivgroup(,
  653.     bguihgroup(,
  654.       bguicycle("eventtype_",,"eventlist_")bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  655.       bguistring("event_",,,256)bguilayout(LGO_FixMinHeight,1),
  656.     )||,
  657.     bguihgroup(,
  658.       bguistring('fontvalue_',Font$':',FontName,256)bguilayout(LGO_Weight,50,LGO_FixMinHeight,1)||,
  659.       bguistring('fontsize_',,FontSize,8)bguilayout(LGO_Weight,10,LGO_FixMinHeight,1)||,
  660.       bguiibutton('addfont_','B','F')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  661.       bguibutton("reset_",Reset$)bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1),
  662.     )||,
  663.     bguihgroup(,
  664.       bguivgroup(,
  665.         bguiinfo('dummy_',,esc'c'Month.Month)bguilayout(LGO_FixMinHeight, 1)||,
  666.         bguihgroup(,
  667.           bguiinfo("dummy_",,esc"c"left(Day.0,1))||,
  668.           bguiinfo("dummy_",,esc"c"left(Day.1,1))||,
  669.           bguiinfo("dummy_",,esc"c"left(Day.2,1))||,
  670.           bguiinfo("dummy_",,esc"c"left(Day.3,1))||,
  671.           bguiinfo("dummy_",,esc"c"left(Day.4,1))||,
  672.           bguiinfo("dummy_",,esc"c"left(Day.5,1))||,
  673.           bguiinfo("dummy_",,esc"c"left(Day.6,1)),
  674.         )||,
  675.         DateButtons,
  676.       )||,
  677.       bguivgroup(,
  678.         bguiinfo("startchoice_",esc"r"Start$':',"")bguilayout(LGO_FixMinHeight, 1)||,
  679.         bguiinfo("endchoice_",esc"r"End$':',"")bguilayout(LGO_FixMinHeight, 1)||,
  680.         bguicycle('textcolor_',esc"r"TextColor$':','TextColorList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  681.         bguicycle("linechoice_",esc"r"Line$':',"linelist_")bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  682.         bguicheckbox("boxchoice_",esc"r"Boxed$':',0)bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  683.         bguicycle('boxcolor_',esc"r"BoxColor$':','ColorList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  684.         bguicycle("weeklychoice_",esc"r"Frequency$':','FrequencyList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  685.         bguihgroup(,
  686.           bguibutton("OK_",OK$)bguilayout(LGO_FixMinHeight,1)||,
  687.           bguibutton("cancel_",Cancel$)bguilayout(LGO_FixMinHeight,1),
  688.         ),
  689.       ),
  690.     ),
  691.   ,"-1","-1")
  692.  
  693.   call UpdateBusy(Req, 1)
  694.   GE_winID=bguiwindow(EnterEventInfo$':',g,5,0,,AppScreen)
  695.   call UpdateBusy(Req, 1)
  696.  
  697.   if App == 'PGS' then do
  698.     FontGroup=bguivgroup(bguilistview('fontlistview_',,'FontList'))
  699.     call UpdateBusy(Req, 1)
  700.     FontwinID=bguiwindow(SelectFont$':',FontGroup,20,50,,AppScreen)
  701.   end
  702.  
  703.   call bguiset(obj.linechoice_,GE_winID,CYC_Active,1)
  704.   call bguiset(obj.boxcolor_,GE_winID,CYC_Active,max(0, MemberID(Background.AddEvent,'ColorList', ColorList.Count, 0)))
  705.   call bguiset(obj.textcolor_,GE_winID,CYC_Active,max(0, MemberID(Color.AddEvent,'ColorList', ColorList.Count, 0)))
  706.   call bguiset(obj.event_,,BT_Key,EventKey)
  707.   call bguiwintabcycleorder(GE_winID,obj.event_||obj.fontsize_)
  708.  
  709.   if bguiwinopen(GE_winID)=0 then bguierror(12)
  710.  
  711.   call CloseBusy(Req)
  712.  
  713.   id=0
  714.   do while 1
  715.     call bguiwinwaitevent(GE_winID,"ID")
  716.     select
  717.       when (id == id.cancel_) | (id == id.winclose) then call Cleanup
  718.       when id == id.winactive then nop
  719.       when id == id.wininactive then nop
  720.       when id == id.event_ then nop
  721.       when id == id.linechoice_ then nop
  722.       when id == id.boxchoice_ then nop
  723.       when id == id.textcolor_ then nop
  724.       when id == id.boxcolor_ then nop
  725.       when id == id.weeklychoice_ then nop
  726.       when id == id.reset_ then do
  727.         FontName = Font.Highlight
  728.         FontSize = FSize.Highlight
  729.         call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,FontName)
  730.         call bguiset(obj.fontsize_, GE_winID, STRINGA_TextVal,FontSize)
  731.       end
  732.       when id == id.fontvalue_ then do
  733.         call bguireq('1b'x||"c"MustUse$,"*"OK$,'',GE_winID)
  734.         call bguiset(obj.fontvalue_, GE_winID,STRINGA_TextVal, FontName)
  735.       end
  736.       when id == id.fontsize_ then nop
  737.       when id == id.addfont_ then do
  738.         call bguiwinbusy(GE_winID)
  739.         if App == 'FW' then do
  740.           FontFile = bguifilereq(CurrentDir'FWFonts/SWOLFonts/', SelectFont$':', GE_winID,,'#?')
  741.           if FontFile ~= '' then call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,FontFile)
  742.         end
  743.         else if App == 'PGS' then do
  744.           call bguiwinopen(FontwinID)
  745.           do while 1
  746.             call bguiwinwaitevent(FontwinID,'ID')
  747.             if id == id.winclose then leave
  748.             if id == id.fontlistview_ then do
  749.               call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,bguiget(obj.fontlistview_, LISTV_LastClicked))
  750.               leave
  751.             end
  752.           end
  753.           call bguiwinclose(FontwinID)
  754.         end
  755.         call bguiwinready(GE_winID)
  756.         FontName = bguiget(obj.fontvalue_, STRINGA_TextVal)
  757.       end
  758.       when id == id.ok_ then do
  759.         GE_EventValue = bguiget(obj.event_, STRINGA_TextVal)
  760.         GE_BoxValue   = bguiget(obj.boxchoice_, GA_Selected)
  761.         GE_EventType  = bguiget(obj.eventtype_, CYC_Active)
  762.         if (GE_StartDate == "") & (GE_EventType == Event$) then call bguireq(EnterStartDate$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
  763.         else if (GE_EventValue == "") & (GE_Boxed.GE_BoxValue == "") then call bguireq(EnterEvent$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
  764.         else do
  765.           GE_WeeklyValue  = bguiget(obj.weeklychoice_, CYC_Active)
  766.  
  767.           EventData = "   EventType = "Type.GE_EventType||'0a'x||,
  768.                       " EnteredFont = "strip(FontName)||'0a'x||,
  769.                       " EnteredSize = "strip(bguiget(obj.fontsize_, STRINGA_TextVal))||'0a'x||,
  770.                       " EnteredDay1 = "strip(GE_StartDate)||'0a'x||,
  771.                       " EnteredDay2 = "strip(GE_EndDate)||'0a'x||,
  772.                       " EnteredLine = "bguiget(obj.linechoice_, CYC_Active)||'0a'x||,
  773.                       "     Options = "GE_Boxed.GE_BoxValue""GE_Weekly.GE_WeeklyValue||'0a'x||,
  774.                       "   TextColor = "value('ColorList.'bguiget(obj.textcolor_, CYC_Active))||'0a'x||,
  775.                       "    BoxColor = "value('ColorList.'bguiget(obj.boxcolor_, CYC_Active))||'0a'x||,
  776.                       "EnteredEvent = "GE_EventValue
  777.  
  778.           call bguiwinclose(GE_winID)
  779.           call ProcessEvent
  780.           call bguiwinopen(GE_winID)
  781.  
  782.           GE_StartOrEnd = 1
  783.           GE_StartDate  = ""
  784.           GE_EndDate    = ""
  785.           call bguiset(obj.startchoice_,GE_winID,INFO_TextFormat,'')
  786.           call bguiset(obj.endchoice_,GE_winID,INFO_TextFormat,'')
  787.         end
  788.       end
  789.       when id == id.eventtype_ then do
  790.         GE_EventType = bguiget(obj.eventtype_, CYC_Active)
  791.         if Type.GE_EventType == Event$ then do
  792.           call bguiset(obj.event_,GE_winID,STRINGA_TextVal,"")
  793.           call bguiset(obj.textcolor_, GE_winID, GA_Disabled, 0)
  794.           call bguiset(obj.boxcolor_, GE_winID, GA_Disabled, 0)
  795.           call bguiset(obj.linechoice_, GE_winID, GA_Disabled, 0)
  796.           call bguiset(obj.boxchoice_, GE_winID, GA_Disabled, 0)
  797.           call bguiset(obj.weeklychoice_, GE_winID, GA_Disabled, 0)
  798.           call bguiset(obj.reset_, GE_winID, GA_Disabled, 0)
  799.           call bguiset(obj.addfont_, GE_winID, GA_Disabled, 0)
  800.           call bguiset(obj.fontsize_, GE_winID, GA_Disabled, 0)
  801.           call bguiset(obj.fontvalue_, GE_winID, GA_Disabled, 0)
  802.         end
  803.         else do
  804.           GE_DataFile = bguifilereq(ScriptDir''"FWCAddEvent.data", SelectFile$, GE_winID,DOPATTERNS,PatVar)
  805.           if ~exists(GE_DataFile) then do
  806.             call bguireq(GE_DataFile' 'CantFind$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
  807.             GE_DataFile = ''
  808.           end
  809.           if GE_DataFile == '' then do
  810.             call bguiset(obj.eventtype_, GE_winID, CYC_Active, 0)
  811.             call bguiset(obj.textcolor_, GE_winID, GA_Disabled, 0)
  812.             call bguiset(obj.boxcolor_, GE_winID, GA_Disabled, 0)
  813.             call bguiset(obj.linechoice_, GE_winID, GA_Disabled, 0)
  814.             call bguiset(obj.boxchoice_, GE_winID, GA_Disabled, 0)
  815.             call bguiset(obj.weeklychoice_, GE_winID, GA_Disabled, 0)
  816.             call bguiset(obj.reset_, GE_winID, GA_Disabled, 0)
  817.             call bguiset(obj.addfont_, GE_winID, GA_Disabled, 0)
  818.             call bguiset(obj.fontsize_, GE_winID, GA_Disabled, 0)
  819.             call bguiset(obj.fontvalue_, GE_winID, GA_Disabled, 0)
  820.           end
  821.           else do
  822.             call bguiset(obj.event_, GE_winID, STRINGA_TextVal,GE_DataFile)
  823.             call bguiset(obj.textcolor_, GE_winID, GA_Disabled, 1)
  824.             call bguiset(obj.boxcolor_, GE_winID, GA_Disabled, 1)
  825.             call bguiset(obj.linechoice_, GE_winID, GA_Disabled, 1)
  826.             call bguiset(obj.boxchoice_, GE_winID, GA_Disabled, 1)
  827.             call bguiset(obj.weeklychoice_, GE_winID, GA_Disabled, 1)
  828.             call bguiset(obj.reset_, GE_winID, GA_Disabled, 1)
  829.             call bguiset(obj.addfont_, GE_winID, GA_Disabled, 1)
  830.             call bguiset(obj.fontsize_, GE_winID, GA_Disabled, 1)
  831.             call bguiset(obj.fontvalue_, GE_winID, GA_Disabled, 1)
  832.           end
  833.         end
  834.       end
  835.       otherwise do
  836.         GE_StartOrEnd = 1 - GE_StartOrEnd
  837.         GE_ReturnDate = strip(substr(GE_Arg.id, 1, 1)""right(GE_Arg.id, 2), "B", "C")
  838.         GE_Date = substr(GE_Arg.id, 3)
  839.         if GE_StartOrEnd == 0 then do
  840.           call bguiset(obj.startchoice_,GE_winID,INFO_TextFormat,esc"l"GE_Date)
  841.           GE_StartDate = GE_ReturnDate
  842.         end
  843.         else do
  844.           call bguiset(obj.endchoice_,GE_winID,INFO_TextFormat,esc"l"GE_Date)
  845.           GE_EndDate = GE_ReturnDate
  846.         end
  847.       end
  848.     end
  849.   end
  850.   exit
  851. /**/
  852.  
  853. /***//*** GetEvent_CA (GE) Subroutine ***/
  854. GetEvent_CA:
  855.   /***//*** Initialize Variables ***/
  856.   Req = OpenBusy(PrepReq$, 4 + (ColorList.Count - 1))
  857.  
  858.   GE_BoxValue     = ''
  859.   GE_EnteredLine  = 1
  860.   GE_EventType    = Event$
  861.   GE_EventValue   = ''
  862.   GE_StartOrEnd   = 1
  863.   GE_StartDate    = ""
  864.   GE_EndDate      = ""
  865.   GE_WeeklyValue  = ''
  866.   GE_Day          = 0
  867.   GE_PrevDay      = MonthLength.PrevMonth - StartDate
  868.   GE_NextDay      = 0
  869.   LineList        = ''
  870.   ColorList       = ''
  871.   FontReq         = 0
  872.   ColorReq        = 0
  873.   NCColorReq      = 0
  874.   interpret 'GE_TextColor = ColorList.'max(0, MemberID(Color.AddEvent,'ColorList', ColorList.Count, 0))
  875.   interpret 'GE_BoxColor = ColorList.'max(0, MemberID(Background.AddEvent,'ColorList', ColorList.Count, 0))
  876.  
  877.   GadID.          = ''
  878.   GadArg.         = ''
  879.   GE_Boxed.0      = ""
  880.   GE_Boxed.1      = "B"
  881.   GE_Type.0       = Event$
  882.   GE_Type.1       = File$
  883.   GE_Weekly.0     = ""
  884.   GE_Weekly.1     = "W"
  885.   GE_Weekly.2     = "2"
  886.  
  887.   do GE_i = 0 to 15
  888.     LineList = LineList''GE_i'|'
  889.   end
  890.   LineList.Count = min(RowsThatFit, 16)
  891.  
  892.   do GE_i = 0 to ColorList.Count - 1
  893.     ColorList = ColorList''ColorList.GE_i'|'
  894.   end
  895.   ColorList = '"'strip(ColorList, 'B', '|')'"'
  896.  
  897.   EventList = '"'Event$'|'File$'"'
  898.   FrequencyList = '"'Once$'|'Weekly$'|'Biweekly$'"'
  899.  
  900.   if UpdateBusy(Req, 1) == -1 then call Cleanup
  901. /**/
  902.  
  903.   /***//*** GUI Description ***/
  904.   call open('GE',"awnpipe:AddEvent/xc")
  905.   call ToPIPE('GE', '"'EnterEventInfo$'" m cg dg v db a so si cs sk h ps="'AppScreen'"')
  906.  
  907.   call ToPIPE('GE', 'layout v so si b=0')
  908.     call ToPIPE('GE', 'layout b=0')
  909.       call AssignID('GE_EventTypeGad', ToPIPE('GE', 'chooser weiw=0 pu cl='EventList' ref'))
  910.       call AssignID('GE_EventGad', ToPIPE('GE', 'string tc lj ref'))
  911.     call ToPIPE('GE', 'le')
  912.  
  913.     call ToPIPE('GE', 'layout b=0')
  914.       call ToPIPE('GE', 'label gt="'Font$':" ua ref')
  915.       call AssignID('GE_FontNameGad', ToPIPE('GE', 'string lj tc chl weiw=95 gt="'FontName'" ref'))
  916.       call AssignID('GE_FontSizeGad', ToPIPE('GE', 'string lj tc minc=4 weiw=0 gt="'FontSize'" ref'))
  917.       call AssignID('GE_ChooseFontGad', ToPIPE('GE', 'button ab=2 weiw=0 weih=0 ref'))
  918.       call AssignID('GE_ResetGad', ToPIPE('GE', 'button weih=0 weiw=0 gt="'Reset$'" ref'))
  919.     call ToPIPE('GE', 'le')
  920.   call ToPIPE('GE', 'le')
  921.  
  922.   call ToPIPE('GE', 'layout weiw=0 b=0')
  923.     call ToPIPE('GE', 'layout weiw=0 so v')
  924.       call ToPIPE('GE', 'layout so b=0')
  925.         call ToPIPE('GE', 'space')
  926.         call AssignID('GE_MonthGad', ToPIPE('GE', 'button ro b=0 gt="'Month.Month'" ref'))
  927.         call ToPIPE('GE', 'space')
  928.       call ToPIPE('GE', 'le')
  929.  
  930.       call ToPIPE('GE', 'layout e b=0')
  931.         call ToPIPE('GE', 'button ro b=0 gt="'left(Day.0, 1)'" ref')
  932.         call ToPIPE('GE', 'button ro b=0 gt="'left(Day.1, 1)'" ref')
  933.         call ToPIPE('GE', 'button ro b=0 gt="'left(Day.2, 1)'" ref')
  934.         call ToPIPE('GE', 'button ro b=0 gt="'left(Day.3, 1)'" ref')
  935.         call ToPIPE('GE', 'button ro b=0 gt="'left(Day.4, 1)'" ref')
  936.         call ToPIPE('GE', 'button ro b=0 gt="'left(Day.5, 1)'" ref')
  937.         call ToPIPE('GE', 'button ro b=0 gt="'left(Day.6, 1)'" ref')
  938.       call ToPIPE('GE', 'le')
  939.  
  940.       if UpdateBusy(Req, 1) == -1 then call Cleanup
  941.  
  942.       do GE_Week = 0 to 5
  943.         call ToPIPE('GE', 'layout e b=0')
  944.         do GE_WeekDay = 0 to 6
  945.           GE_Posn = (GE_Week * 7) + GE_WeekDay
  946.           if (GE_Posn >= StartDate) & (GE_Posn < StartDate + MonthLength.Month) then do
  947.             GE_Day = GE_Day + 1
  948.             call AssignID('GadID.'GE_Posn, ToPIPE('GE', 'button gt="'GE_Day'" ref'))
  949.             interpret "GadArg."GadID.GE_Posn" = 'C'left(Month.Month, 3)' 'GE_Day"
  950.           end
  951.           else do
  952.             if GE_Posn < StartDate then do
  953.               GE_PrevDay = GE_PrevDay + 1
  954.               call AssignID('GadID.'GE_Posn, ToPIPE('GE', 'button gt="'GE_PrevDay'" ref'))
  955.               interpret "GadArg."GadID.GE_Posn" = 'P'left(Month.PrevMonth, 3)' 'GE_PrevDay"
  956.             end
  957.             else do
  958.               GE_NextDay = GE_NextDay + 1
  959.               call AssignID('GadID.'GE_Posn, ToPIPE('GE', 'button gt="'GE_NextDay'" ref'))
  960.               interpret "GadArg."GadID.GE_Posn" = 'N'left(Month.NextMonth, 3)' 'GE_NextDay"
  961.             end
  962.           end
  963.         end
  964.         call ToPIPE('GE', 'le')
  965.         if GE_Posn >= StartDate + MonthLength.Month - 1 then leave
  966.       end
  967.     call ToPIPE('GE', 'le')
  968.  
  969.     if UpdateBusy(Req, 1) == -1 then call Cleanup
  970.     call ToPIPE('GE', 'layout weiw=0 si so v')
  971.       call ToPIPE('GE', 'layout weiw=0 si so b=0 v')
  972.         call ToPIPE('GE', 'label weiw=0 ua gt="'Start$':" ref')
  973.         call AssignID('GE_StartGad', ToPIPE('GE', 'button lj chl ro b=0 ref'))
  974.         call ToPIPE('GE', 'label weiw=0 ua gt="'End$':" ref')
  975.         call AssignID('GE_EndGad', ToPIPE('GE', 'button lj chl ro b=0 ref'))
  976.         call ToPIPE('GE', 'label weiw=0 gt="'TextColor$':" ua ref')
  977.         call AssignID('GE_TextColorGad', ToPIPE('GE', 'Button chl gt="'Color.AddEvent'" ref'))
  978.         call ToPIPE('GE', 'label weiw=0 gt="'Line$':" ua ref')
  979.         call AssignID('GE_LineGad', ToPIPE('GE', 'chooser chl pu weiw=0 s=1 maxn='LineList.Count' cl='LineList' ref'))
  980.         call ToPIPE('GE', 'label weiw=0 gt="'Boxed$':" ua ref')
  981.         call AssignID('GE_BoxedGad', ToPIPE('GE', 'checkbox weiw=0 chl ref'))
  982.         call ToPIPE('GE', 'label weiw=0 gt="'BoxColor$':" ua ref')
  983.         call AssignID('GE_BoxColorGad', ToPIPE('GE', 'Button chl gt="'Background.AddEvent'" ref'))
  984.         call ToPIPE('GE', 'label weiw=0 gt="'Frequency$':" ua ref')
  985.         call AssignID('GE_FrequencyGad', ToPIPE('GE', 'chooser chl pu weiw=0 maxn=3 cl='FrequencyList' ref'))
  986.       call ToPIPE('GE', 'le')
  987.       call ToPIPE('GE', 'layout v si e cj b=0')
  988.         call ToPIPE('GE', 'layout si e weiw=0 b=0')
  989.           call AssignID('GE_OKGad', ToPIPE('GE', 'button weiw=0 weih=0 gt="'OK$'" ref'))
  990.           call AssignID('GE_CancelGad', ToPIPE('GE', 'button weiw=0 weih=0 c gt="'Cancel$'" ref'))
  991.         call ToPIPE('GE', 'le')
  992.       call ToPIPE('GE', 'le')
  993.     call ToPIPE('GE', 'le')
  994.   call ToPIPE('GE', 'le')
  995.  
  996.   GetFileAllGad = ToPIPE('GE', 'getfile ua pat="#?"')
  997.   GetFileDataGad = ToPIPE('GE', 'getfile ua pat="'PatVar'"')
  998.  
  999.   if App == 'PGS' then do
  1000.     call open('FontReq', "awnpipe:FontReq/xc")
  1001.     call ToPIPE('FontReq', '"'SelectFont$'" m db dg v a ps="'AppScreen'"')
  1002.     call ToPIPE('FontReq', 'listbrowser minw=200 minh=300')
  1003.     do GE_FontNumber = 0 to FontList.COUNT - 1
  1004.       GadID = ToPIPE('FontReq', 'browsernode gt="'FontList.GE_FontNumber'" ref')
  1005.       interpret 'FontGad.'GadID' = 'GE_FontNumber
  1006.     end
  1007.   end
  1008.  
  1009.   call open('ColorReq','awnpipe:ColorReq/xc')
  1010.   call ToPIPE('ColorReq','"Select color:" m db dg v a ps="'AppScreen'"')
  1011.   call ToPIPE('ColorReq','listbrowser minw 150 minh 75 lbl "Color|Sample" ref')
  1012.  
  1013.   call open('NCColorReq','awnpipe:NCColorReq/xc')
  1014.   call ToPIPE('NCColorReq','"Select color:" m db dg v a ps="'AppScreen'"')
  1015.   call ToPIPE('NCColorReq','listbrowser minw 150 minh 75 lbl "Color|Sample" ref')
  1016.  
  1017.   if App == 'FW' then do
  1018.     do GE_ColorNumber = 0 to ColorList.Count - 2
  1019.       if UpdateBusy(Req, 1) == -1 then call Cleanup
  1020.       RPen = dTox(x2d(left(ColorRegister.GE_ColorNumber, 2)) / 255 * 4294967295)
  1021.       GPen = dTox(x2d(substr(ColorRegister.GE_ColorNumber, 3, 2)) / 255 * 4294967295)
  1022.       BPen = dTox(x2d(right(ColorRegister.GE_ColorNumber, 2)) / 255 * 4294967295)
  1023.  
  1024.       call ToPIPE('ColorReq','penmap pmp 1|'RPen'|'GPen'|'BPen' pmd 0|'d2x(ColorW)'|0|'d2x(ColorH)''copies('|0', ColorW * ColorH))
  1025.       GadID = ToPIPE('ColorReq','browsernode gt="'ColorList.GE_ColorNumber'|¶" ref')
  1026.       interpret 'ColorGad.'GadID' = 'GE_ColorNumber
  1027.  
  1028.       call ToPIPE('NCColorReq','penmap pmp 1|'RPen'|'GPen'|'BPen' pmd 0|'d2x(ColorW)'|0|'d2x(ColorH)''copies('|0', ColorW * ColorH))
  1029.       GadID = ToPIPE('NCColorReq','browsernode gt="'ColorList.GE_ColorNumber'|¶" ref')
  1030.       interpret 'NCColorGad.'GadID' = 'GE_ColorNumber
  1031.     end
  1032.     GadID = ToPIPE('ColorReq','browsernode gt="<'Clear$'>|¶" ref')
  1033.     interpret 'ColorGad.'GadID' = 'GE_ColorNumber
  1034.   end
  1035.   else if App == 'PGS' then do
  1036.     do GE_ColorNumber = 0 to ColorList.Count - 2
  1037.       if UpdateBusy(Req, 1) == -1 then call Cleanup
  1038.       GadID = ToPIPE('ColorReq','browsernode gt="'ColorList.GE_ColorNumber'|" ref')
  1039.       interpret 'ColorGad.'GadID' = 'GE_ColorNumber
  1040.       GadID = ToPIPE('NCColorReq','browsernode gt="'ColorList.GE_ColorNumber'|" ref')
  1041.       interpret 'NCColorGad.'GadID' = 'GE_ColorNumber
  1042.     end
  1043.     GadID = ToPIPE('ColorReq','browsernode gt="<'Clear$'>|" ref')
  1044.     interpret 'ColorGad.'GadID' = 'GE_ColorNumber
  1045.   end
  1046.  
  1047. /**/
  1048.  
  1049.   /***//*** GUI Action Loop ***/
  1050.   call ToPIPE('GE', 'open')
  1051.   call UpdateBusy(Req, 1)
  1052.  
  1053.   call CloseBusy('ProgReq')
  1054.  
  1055.   do until eof('GE')
  1056.     call ToPIPE('GE', 'continue')
  1057.     GE_EventInfo = readln('GE')
  1058.     parse var GE_EventInfo GE_Event' 'GE_GadID' 'GE_GadInfo1
  1059.     select
  1060.     /***//*** close ***/
  1061.       when GE_Event == 'close' then call Cleanup
  1062.     /**/
  1063.  
  1064.     /***//*** Help event ***/
  1065.       when GE_Event == 'help' then do
  1066.         if GE_GadID ~= -1 then OverGad = GE_GadID
  1067.       end
  1068.     /**/
  1069.  
  1070.     /***//*** Key event ***/
  1071.       when GE_Event == 'key' then do
  1072.         HelpGad = GE_Help.OverGad
  1073.         interpret 'HelpText = Help$.'HelpGad
  1074.         if (GE_GadID == 95) & (symbol('Help$.'HelpGad) == 'VAR') then
  1075.           call CASimpleReq(Help$, HelpText, HelpTime)
  1076.       end
  1077.     /**/
  1078.  
  1079.     /***//*** GE_EventTypeGad ***/
  1080.       when GE_GadID == GE_EventTypeGad then do
  1081.         GE_EventType = GE_Type.GE_GadInfo1
  1082.         if GE_EventType == Event$ then do
  1083.           GE_StartOrEnd = 1
  1084.           call ToPIPE('GE', 'id 'GE_EventGad' gt="" ref')
  1085.           call ToPIPE('GE', 'id 'GE_FontNameGad' dis=0 ref')
  1086.           call ToPIPE('GE', 'id 'GE_FontSizeGad' dis=0 ref')
  1087.           call ToPIPE('GE', 'id 'GE_ChooseFontGad' dis=0 ref')
  1088.           call ToPIPE('GE', 'id 'GE_ResetGad' dis=0 ref')
  1089.           call ToPIPE('GE', 'id 'GE_TextColorGad' dis=0 ref')
  1090.           call ToPIPE('GE', 'id 'GE_LineGad' dis=0 ref')
  1091.           call ToPIPE('GE', 'id 'GE_BoxedGad' dis=0 ref')
  1092.           call ToPIPE('GE', 'id 'GE_BoxColorGad' dis=0 ref')
  1093.           call ToPIPE('GE', 'id 'GE_FrequencyGad' dis=0 ref')
  1094.         end
  1095.         else do
  1096.           GE_DataFile = CAGetFile('GE', GetFileDataGad, SelectFile$, ScriptDir'FWCAddEvent.data')
  1097.           if GE_DataFile ~= '' then do
  1098.             if ~exists(GE_DataFile) then do
  1099.               call ToPIPE('GE', 'id 0 s=256')
  1100.               call CASimpleReq('FWCAddEvent 'Notice$, GE_DataFile' 'CantFind$'...')
  1101.               call ToPIPE('GE', 'id 0 s=512')
  1102.               GE_DataFile = ''
  1103.             end
  1104.             else do
  1105.               GE_EndDate = ''
  1106.               GE_EventValue = GE_DataFile
  1107.               call ToPIPE('GE', 'id 'GE_EndGad' gt="" ref')
  1108.               call ToPIPE('GE', 'id 'GE_EventGad' gt="'GE_DataFile'" ref')
  1109.               call ToPIPE('GE', 'id 'GE_FontNameGad' dis=1 ref')
  1110.               call ToPIPE('GE', 'id 'GE_FontSizeGad' dis=1 ref')
  1111.               call ToPIPE('GE', 'id 'GE_ChooseFontGad' dis=1 ref')
  1112.               call ToPIPE('GE', 'id 'GE_ResetGad' dis=1 ref')
  1113.               call ToPIPE('GE', 'id 'GE_TextColorGad' dis=1 ref')
  1114.               call ToPIPE('GE', 'id 'GE_LineGad' dis=1 ref')
  1115.               call ToPIPE('GE', 'id 'GE_BoxedGad' dis=1 ref')
  1116.               call ToPIPE('GE', 'id 'GE_BoxColorGad' dis=1 ref')
  1117.               call ToPIPE('GE', 'id 'GE_FrequencyGad' dis=1 ref')
  1118.             end
  1119.           end
  1120.           if GE_DataFile == '' then do
  1121.             GE_StartOrEnd = 1
  1122.             GE_EventType = Event$
  1123.             call ToPIPE('GE', 'id 'GE_EventTypeGad' s=0 ref')
  1124.             call ToPIPE('GE', 'id 'GE_EventGad' gt="" ref')
  1125.             call ToPIPE('GE', 'id 'GE_FontNameGad' dis=0 ref')
  1126.             call ToPIPE('GE', 'id 'GE_FontSizeGad' dis=0 ref')
  1127.             call ToPIPE('GE', 'id 'GE_ChooseFontGad' dis=0 ref')
  1128.             call ToPIPE('GE', 'id 'GE_ResetGad' dis=0 ref')
  1129.             call ToPIPE('GE', 'id 'GE_TextColorGad' dis=0 ref')
  1130.             call ToPIPE('GE', 'id 'GE_LineGad' dis=0 ref')
  1131.             call ToPIPE('GE', 'id 'GE_BoxedGad' dis=0 ref')
  1132.             call ToPIPE('GE', 'id 'GE_BoxColorGad' dis=0 ref')
  1133.             call ToPIPE('GE', 'id 'GE_FrequencyGad' dis=0 ref')
  1134.           end
  1135.         end
  1136.       end
  1137.     /**/
  1138.  
  1139.     /***//*** GE_EventGad ***/
  1140.       when GE_GadID == GE_EventGad then GE_EventValue = GE_GadInfo1
  1141.     /**/
  1142.  
  1143.     /***//*** GE_FontNameGad ***/
  1144.       when GE_GadID == GE_FontNameGad then do
  1145.         call ToPIPE('GE', 'id 0 s=256')
  1146.         call CASimpleReq('FWCalendar 'Notice$, MustUse$)
  1147.         call ToPIPE('GE', 'id 0 s=512')
  1148.         call ToPIPE('GE', 'id 'GE_FontNameGad' gt="'FontName'" ref')
  1149.       end
  1150.     /**/
  1151.  
  1152.     /***//*** GE_FontSizeGad ***/
  1153.       when GE_GadID == GE_FontSizeGad then FontSize = GE_GadInfo1
  1154.     /**/
  1155.  
  1156.     /***//*** GE_ChooseFontGad ***/
  1157.       when GE_GadID == GE_ChooseFontGad then do
  1158.         if App == 'FW' then do
  1159.           GE_File = CAGetFile('GE', GetFileAllGad, SelectFont$, CurrentDir'FWFonts/SWOLFonts/')
  1160.           if GE_File ~= '' then do
  1161.             FontName = GE_File
  1162.             call ToPIPE('GE', 'id 'GE_FontNameGad' gt="'FontName'" ref')
  1163.           end
  1164.         end
  1165.         else if App == 'PGS' then do
  1166.           call ToPIPE('GE', 'id 0 s=256')
  1167.             FontName = ReadBrowserList('FontReq', 'FontGad', 'FontList', FontName)
  1168.             call ToPIPE('GE', 'id 'GE_FontNameGad' gt="'FontName'" ref')
  1169.           call ToPIPE('GE', 'id 0 s=512')
  1170.         end
  1171.       end
  1172.     /**/
  1173.  
  1174.     /***//*** GE_ResetGad ***/
  1175.       when GE_GadID == GE_ResetGad then do
  1176.         FontName = Font.Highlight
  1177.         FontSize = FSize.Highlight
  1178.         call ToPIPE('GE', 'id 'GE_FontNameGad' gt="'FontName'"')
  1179.         call ToPIPE('GE', 'id 'GE_FontSizeGad' gt="'FontSize'"')
  1180.       end
  1181.     /**/
  1182.  
  1183.     /***//*** Date Gadgets ***/
  1184.       when GadArg.GE_GadID ~= '' then do
  1185.         if GE_EventType == File$ then GE_StartOrEnd = 0
  1186.         else GE_StartOrEnd = 1 - GE_StartOrEnd
  1187.         GE_ReturnDate = strip(left(GadArg.GE_GadID, 1)''right(GadArg.GE_GadID, 2), "B", "C")
  1188.         GE_Date = substr(GadArg.GE_GadID, 2)
  1189.         if GE_StartOrEnd == 0 then do
  1190.           call ToPIPE('GE', 'id 'GE_StartGad' gt="'GE_Date'" ref')
  1191.           GE_StartDate = GE_ReturnDate
  1192.         end
  1193.         else do
  1194.           call ToPIPE('GE', 'id 'GE_EndGad' gt="'GE_Date'" ref')
  1195.           GE_EndDate = GE_ReturnDate
  1196.         end
  1197.       end
  1198.     /**/
  1199.  
  1200.     /***//*** GE_TextColorGad ***/
  1201.       when GE_GadID == GE_TextColorGad then do
  1202.         call ToPIPE('GE', 'id 0 s=256')
  1203.         GE_TextColor = ReadBrowserList('NCColorReq', 'NCColorGad', 'ColorList')
  1204.         call ToPIPE('GE', 'id 'GE_TextColorGad' gt="'GE_TextColor'"')
  1205.         call ToPIPE('GE', 'id 0 s=512')
  1206.       end
  1207.     /**/
  1208.  
  1209.     /***//*** GE_LineGad ***/
  1210.       when GE_GadID == GE_LineGad then GE_EnteredLine = GE_GadInfo1
  1211.     /**/
  1212.  
  1213.     /***//*** GE_BoxedGad ***/
  1214.       when GE_GadID == GE_BoxedGad then GE_BoxValue = GE_Boxed.GE_GadInfo1
  1215.     /**/
  1216.  
  1217.     /***//*** GE_BoxColorGad ***/
  1218.       when GE_GadID == GE_BoxColorGad then do
  1219.         call ToPIPE('GE', 'id 0 s=256')
  1220.         GE_BoxColor = ReadBrowserList('ColorReq', 'ColorGad', 'ColorList')
  1221.         call ToPIPE('GE', 'id 'GE_BoxColorGad' gt="'GE_BoxColor'"')
  1222.         call ToPIPE('GE', 'id 0 s=512')
  1223.       end
  1224.     /**/
  1225.  
  1226.     /***//*** GE_FrequencyGad ***/
  1227.       when GE_GadID == GE_FrequencyGad then GE_WeeklyValue = GE_Weekly.GE_GadInfo1
  1228.     /**/
  1229.  
  1230.     /***//*** GE_OKGad ***/
  1231.       when GE_GadID == GE_OKGad then do
  1232.         if (GE_StartDate == "") & (GE_EventType == Event$) then do
  1233.           call ToPIPE('GE', 'id 0 s=256')
  1234.           call CASimpleReq('FWCAddEvent 'Notice$, EnterStartDate$'...')
  1235.           call ToPIPE('GE', 'id 0 s=512')
  1236.         end
  1237.         else if (GE_EventValue == "") & (GE_BoxValue == "") then do
  1238.           call ToPIPE('GE', 'id 0 s=256')
  1239.           call CASimpleReq('FWCAddEvent 'Notice$, EnterEvent$'...')
  1240.           call ToPIPE('GE', 'id 0 s=512')
  1241.         end
  1242.         else do
  1243.           EventData = "   EventType = "GE_EventType||'0a'x||,
  1244.                       " EnteredDay1 = "strip(GE_StartDate)||'0a'x||,
  1245.                       " EnteredDay2 = "strip(GE_EndDate)||'0a'x||,
  1246.                       "   TextColor = "GE_TextColor||'0a'x||,
  1247.                       " EnteredLine = "GE_EnteredLine||'0a'x||,
  1248.                       "    BoxColor = "GE_BoxColor||'0a'x||,
  1249.                       "     Options = "GE_BoxValue""GE_WeeklyValue||'0a'x||,
  1250.                       " EnteredFont = "strip(FontName)||'0a'x||,
  1251.                       " EnteredSize = "strip(FontSize)||'0a'x||,
  1252.                       "EnteredEvent = "GE_EventValue
  1253.           call ToPIPE('GE', 'id 0 s=128')
  1254.           call ProcessEvent
  1255.           call ToPIPE('GE', 'id 0 s=64')
  1256.  
  1257.           GE_StartOrEnd = 1
  1258.           GE_StartDate  = ""
  1259.           GE_EndDate    = ""
  1260.           call ToPIPE('GE', 'id 'GE_StartGad' gt="" ref')
  1261.           call ToPIPE('GE', 'id 'GE_EndGad' gt="" ref')
  1262.         end
  1263.       end
  1264.     /**/
  1265.  
  1266.       otherwise nop
  1267.     end
  1268.   end
  1269. /**/
  1270.   exit
  1271. /**/
  1272.  
  1273. /***//*** GetFontWidth (GFW) Subroutine ***/
  1274. GetFontWidth:
  1275.   parse arg GFW_FontType, GFW_Char
  1276.  
  1277.   GFW_ID = PrintText(1, 1, GFW_FontType, 'N', White$, Width.GFW_FontType, GFW_Char)
  1278.   if App == 'FW' then do
  1279.     REDRAW
  1280.     GETOBJECTCOORDS GFW_ID; parse var RESULT . . . GFW_Width .
  1281.     DELETEOBJECT GFW_ID
  1282.   end
  1283.   else if App == 'PGS' then do
  1284.     GETTEXTOBJ POSITION GFW_Text OBJECTID GFW_ID WINDOW winName
  1285.     GFW_Width = GFW_Text.Right - GFW_Text.Left
  1286.     DELETEOBJECT OBJECTID GFW_ID WINDOW winName
  1287.   end
  1288. return GFW_Width
  1289. /**/
  1290.  
  1291. /***//*** GetHeight (GH) Subroutine ***/
  1292. GetHeight:
  1293.   parse arg GH_FontType
  1294.  
  1295.   if App == 'FW' then do
  1296.     TEXTBLOCKTYPEPREFS SIZE FSize.GH_FontType FONT Font.GH_FontType
  1297.     DRAWTEXTBLOCK 1 1 1 'A'; GH_id = result
  1298.     GETOBJECTCOORDS GH_id; Parse Var result . . . . GH_Text.Height
  1299.     DELETEOBJECT GH_id
  1300.   end
  1301.   else if App == 'PGS' then do
  1302.     DRAWTEXTOBJ 0 0 WINDOW winName; GH_id = result
  1303.     SELECTTEXT AT 0 0 WINDOW winName
  1304.     BEGINCOMMANDCAPTURE
  1305.       SETLEADING RELATIVE 100
  1306.       SETTYPESIZE FSize.GH_FontType WINDOW winName
  1307.       SETFONT Font.GH_FontType WINDOW winName
  1308.     ENDCOMMANDCAPTURE
  1309.     INSERT 'A' WINDOW winName
  1310.     GETTEXTOBJ POSITION GH_Text OBJECTID GH_id WINDOW winName
  1311.     GH_Text.Height = GH_Text.Bottom - GH_Text.Top
  1312.     DELETEOBJECT OBJECTID GH_id WINDOW winName
  1313.   end
  1314.   return GH_Text.Height
  1315. /**/
  1316.  
  1317. /***//*** GetID (GI) Subroutine ***/
  1318. GetID:
  1319. parse arg GI_var
  1320.  
  1321. return id.GI_var
  1322. /**/
  1323.  
  1324. /***//*** GetWidth (GW) Subroutine ***/
  1325. GetWidth:
  1326.   parse arg GW_ID
  1327.  
  1328.   if App = 'FW' then do
  1329.     GETOBJECTCOORDS GW_ID
  1330.     Parse Var result . . . GW_width .
  1331.   end
  1332.   else if App == 'PGS' then do
  1333.     SELECTOBJECT OBJECTID GW_ID  WINDOW winName
  1334.     GETOBJECT BOUNDINGBOX GW_Temp WINDOW winName
  1335.     GW_width = GW_Temp.Right - GW_Temp.Left
  1336.   end
  1337.  
  1338.   return GW_width
  1339. /**/
  1340.  
  1341. /***//*** MemberID (MI) ***/
  1342. MemberID:
  1343.   parse arg MI_Member, MI_Array, MI_Count, MI_Start
  1344.  
  1345.   if MI_Count == '' then interpret 'MI_Count = 'MI_Array'.Count'
  1346.   if MI_Start == '' then do
  1347.     if symbol(MI_Array'.Start') == 'VAR' then interpret 'MI_Start = 'MI_Array'.Start'
  1348.     else MI_Start = 0
  1349.   end
  1350.  
  1351.   do MI_i = MI_Start to MI_Start + MI_Count - 1
  1352.     if upper(value(MI_Array'.'MI_i)) == upper(MI_Member) then return MI_i
  1353.   end
  1354.   return -1
  1355. /**/
  1356.  
  1357. /***//*** NameOnly (PROCEDURE) ***/
  1358. NameOnly: PROCEDURE
  1359.   parse arg FileWithPath
  1360.   return substr(FileWithPath, max(lastpos(':', FileWithPath), lastpos('/', FileWithPath)) + 1)
  1361. /**/
  1362.  
  1363. /***//*** ParseVariables (PV) Subroutine ***/
  1364. ParseVariables:
  1365.   parse arg PV_Line
  1366.  
  1367.   PV_String = translate(PV_Line,,'=(+-*/,)"'||"'",' ')
  1368.   PV_VarString = ''
  1369.   PV_Var.      = '00'x
  1370.   PV_LongVar   = 4
  1371.   PV_LIT       = ''
  1372.   PV_Count     = 0
  1373.  
  1374.   do PV_i = 1 to words(PV_String)
  1375.     PV_Word = word(PV_String, PV_i)
  1376.     if pos(PV_Word'(', PV_Line) > 0 then iterate
  1377.     if datatype(PV_Word) == 'CHAR' then do
  1378.       if symbol(PV_Word) == 'LIT' then PV_LIT = PV_LIT''PV_Word', '
  1379.       if symbol(PV_Word) == 'VAR' then do
  1380.         PV_LongVar = max(PV_LongVar, length(PV_Word) + 2)
  1381.         if PV_Var.PV_Word == '00'x then do
  1382.           PV_Count = PV_Count + 1
  1383.           PV_Var.PV_Count = PV_Word
  1384.           PV_Var.PV_Word  = value(PV_Word)
  1385.         end
  1386.         if pos('.', PV_Word) > 0 then do
  1387.           PV_CompoundParts = subword(translate(PV_Word,,'.', ' '), 2)
  1388.           do PV_j = 1 to words(PV_CompoundParts)
  1389.             PV_Subword = word(PV_CompoundParts, PV_j)
  1390.             if PV_Var.PV_SubWord == '00'x then do
  1391.               PV_Count = PV_Count + 1
  1392.               PV_Var.PV_Count = PV_SubWord
  1393.               if symbol(PV_Subword) == 'LIT' then PV_Var.PV_SubWord  = 'LIT'
  1394.               else PV_Var.PV_SubWord  = value(PV_SubWord)
  1395.             end
  1396.           end
  1397.         end
  1398.       end
  1399.     end
  1400.   end
  1401.  
  1402.   do PV_i = 1 to PV_Count
  1403.     PV_Word = PV_Var.PV_i
  1404.     if length(PV_Var.PV_Word) > 50 then PV_Var.PV_Word = left(PV_Var.PV_Word, 50)'...'
  1405.     PV_Var.PV_Word = translate(PV_Var.PV_Word,,'0a'x||'0d'x||'00'x,'bb'x)
  1406.     PV_VarString = PV_VarString''right(PV_Word, PV_LongVar)' = 'PV_Var.PV_Word||'0a'x
  1407.   end
  1408.  
  1409.   if PV_LIT ~= '' then PV_VarString = right('LIT', PV_LongVar)' = 'strip(PV_LIT, 'B', ' ,')||'0a'x||PV_VarString
  1410.  
  1411.   return PV_VarString
  1412. /**/
  1413.  
  1414. /***//*** PathPart (PROCEDURE) ***/
  1415. PathPart: PROCEDURE
  1416.   parse arg FileWithPath
  1417.   return left(FileWithPath, max(lastpos(':', FileWithPath), lastpos('/', FileWithPath)))
  1418. /**/
  1419.  
  1420. /***//*** PgmVer (PROCEDURE) ***/
  1421. PgmVer: PROCEDURE
  1422.   parse arg Program
  1423.  
  1424.   address command 'version 'Program '>PIPE:FWC file'
  1425.  
  1426.   return strip(word(ReadFile('PIPE:FWC'), 2))
  1427. /**/
  1428.  
  1429. /***//*** PrintText (PT) Subroutine ***/
  1430. PrintText:
  1431.   parse arg PT_Left, PT_Top, PT_FontType, PT_Style, PT_Color, PT_Width, PT_Text
  1432.  
  1433.   if upper(PT_Style) == 'N' then PT_Font = Font.PT_FontType
  1434.   else PT_Font = Bold.PT_FontType
  1435.  
  1436.   if App == 'FW' then do
  1437.     if left(PT_Text, 1) == '"' then PT_Text = '""'PT_Text
  1438.     PT_Top = PT_Top + TextAdj * Height.PT_FontType
  1439.     TEXTBLOCKTYPEPREFS SIZE FSize.PT_FontType WIDTH trunc(PT_Width) COLOR '"'PT_Color'"' FONT PT_Font
  1440.     DRAWTEXTBLOCK 1 PT_Left PT_Top PT_Text; PT_id = result
  1441.   end
  1442.   else if App == 'PGS' then do
  1443.     DRAWTEXTOBJ PT_Left PT_Top WINDOW winName; PT_id = result
  1444.     SELECTTEXT AT PT_Left PT_Top WINDOW winName
  1445.     BEGINCOMMANDCAPTURE
  1446.       SETLEADING RELATIVE 100
  1447.       SETTYPESIZE FSize.PT_FontType WINDOW winName
  1448.       SETTYPEWIDTH PT_Width WINDOW winName
  1449.       SETFONT PT_Font WINDOW winName
  1450.       SETCOLORSTYLE '"'PT_Color'"' COLORNUMBER 0 FILL TEXT WINDOW winName
  1451.     ENDCOMMANDCAPTURE
  1452.     if pos('"', PT_Text) > 0 then do
  1453.       call WriteFile('PIPE:Text2Insert.txt', PT_Text)
  1454.       INSERTTEXT FILE 'PIPE:Text2Insert.txt' FILTER ASCII WINDOW winName
  1455.     end
  1456.     else INSERT '"'PT_Text'"' WINDOW winName
  1457.   end
  1458.   return PT_id
  1459. /**/
  1460.  
  1461. /***//*** ProcessEvent (PE) Subroutine ***/
  1462. ProcessEvent:
  1463.   Day1 = ''
  1464.   Day2 = ''
  1465.   EnteredLine = 1
  1466.   Options = ''
  1467.   EnteredEvent = ''
  1468.   Box = 0
  1469.   Weekly = 0
  1470.   WindowRefreshed = 0
  1471.   Keywords = '|FONT|SIZE|START|END|LINE|EVENT|OPTIONS|TEXTCOLOR|BOXCOLOR|ENTEREDFONT|ENTEREDSIZE|ENTEREDDAY1|ENTEREDDAY2|ENTEREDLINE|ENTEREDEVENT|'
  1472.  
  1473.   if EventData == 0 then call CleanUp
  1474.   call openv('EventData')
  1475.     do until eofv('EventData')
  1476.       PE_Ln = readvln('EventData')
  1477.       interpret strip(word(PE_Ln, 1))' = strip(subword(PE_Ln, 3))'
  1478.     end
  1479.   call closev('EventData')
  1480.  
  1481.   Event. = ''
  1482.   if EventType == Event$ then do
  1483.     Event.0   = 1
  1484.     Event.1   = EventData
  1485.     EventFile = ''
  1486.   end
  1487.   else do
  1488.     EventFile = EnteredEvent
  1489.     if EnteredDay1 == '' then EnteredDay1 = 0
  1490.     RootDay = ConvertDay(EnteredDay1)
  1491.  
  1492.     call open('EventFile', EventFile)
  1493.       EventCount = 1
  1494.       do until eof('EventFile')
  1495.         Ln = ReadLn('EventFile')
  1496.         if eof('EventFile') == 0 then do
  1497.           if (pos('|'upper(word(Ln, 1))'|', Keywords) == 0) & (Ln ~= '') then do
  1498.             interpret Ln
  1499.             iterate
  1500.           end
  1501.           if Ln == '' then do
  1502.             if Event.1 ~= '' then EventCount = EventCount + 1
  1503.             iterate
  1504.           end
  1505.           Event.EventCount = Event.EventCount''Ln||'0a'x
  1506.         end
  1507.       end
  1508.       Event.0 = EventCount
  1509.     call close('EventFile')
  1510.   end
  1511.  
  1512.   if Event.0 > 1 then Req = OpenBusy(ProcessEvents$, Event.0)
  1513.   if App == 'PGS' then do
  1514.     REFRESH OFF ALL
  1515.   end
  1516.   do EC = 1 to Event.0
  1517.     if UpdateBusy(Req, 1) == -1 then call Cleanup
  1518.     Box    = 0
  1519.     Weekly = 0
  1520.     EnteredFont = Font.Highlight
  1521.     EnteredSize = FSize.Highlight
  1522.     EnteredDay1 = ''
  1523.     EnteredDay2 = ''
  1524.     EnteredLine = ''
  1525.     EnteredEvent = ''
  1526.     Options = ''
  1527.     BoxColor = ''
  1528.     TextColor = ''
  1529.  
  1530.     if Event.EC == '' then iterate
  1531.     call openv('Event.EC')
  1532.       do until eofv('Event.EC')
  1533.         PE_Ln = readvln('Event.EC')
  1534.         PE_Variable = upper(strip(word(PE_Ln, 1)))
  1535.         select
  1536.           when PE_Variable == 'FONT' then PE_Variable = 'EnteredFont'
  1537.           when PE_Variable == 'SIZE' then PE_Variable = 'EnteredSize'
  1538.           when PE_Variable == 'START' then PE_Variable = 'EnteredDay1'
  1539.           when PE_Variable == 'END' then PE_Variable = 'EnteredDay2'
  1540.           when PE_Variable == 'LINE' then PE_Variable = 'EnteredLine'
  1541.           when PE_Variable == 'EVENT' then PE_Variable = 'EnteredEvent'
  1542.           when PE_Variable == 'OPTIONS' then nop
  1543.           when PE_Variable == 'TEXTCOLOR' then nop
  1544.           when PE_Variable == 'BOXCOLOR' then nop
  1545.           when PE_Variable == 'ENTEREDFONT' then nop
  1546.           when PE_Variable == 'ENTEREDSIZE' then nop
  1547.           when PE_Variable == 'ENTEREDDAY1' then nop
  1548.           when PE_Variable == 'ENTEREDDAY2' then nop
  1549.           when PE_Variable == 'ENTEREDLINE' then nop
  1550.           when PE_Variable == 'ENTEREDEVENT' then nop
  1551.           when PE_Variable == 'COMMENT' then nop
  1552.           otherwise PE_Variable = 'Error'
  1553.         end
  1554.         if PE_Variable ~= 'Error' then interpret PE_Variable'= strip(subword(PE_Ln, 3))'
  1555.       end
  1556.     call closev('Event.EC')
  1557.     if PE_Variable == 'Error' then do
  1558.       call AddMsg('W', 'Line "'PE_Ln'" does not start with a keyword; this event set was skipped.')
  1559.       iterate EC
  1560.     end
  1561.     EnteredFont = strip(EnteredFont, 'B', '"'||"'")
  1562.     TextColor   = strip(TextColor, 'B', '"'||"'")
  1563.     BoxColor    = strip(BoxColor, 'B', '"'||"'")
  1564.     Options     = compress(upper(strip(Options, 'B', ' "'||"'")))
  1565.  
  1566.     if App == 'FW' then EnteredSize = max(trunc(EnteredSize), 4)
  1567.  
  1568.     FontInfo = compress(EnteredFont''EnteredSize, '. /:')
  1569.     if FontKnown.FontInfo == '' then do
  1570.       HighestFont = HighestFont + 1
  1571.       FontKnown.FontInfo = HighestFont
  1572.       Font.HighestFont = EnteredFont
  1573.       FSize.HighestFont = EnteredSize
  1574.       Height.HighestFont = GetHeight(HighestFont) * Leading/100
  1575.     end
  1576.     CurrentFont = FontKnown.FontInfo
  1577.  
  1578.     If EnteredDay2 == "" then EnteredDay2 = EnteredDay1
  1579.     If EnteredLine == '' then EnteredLine = 1
  1580.     if BoxColor    == '' then BoxColor = Background.AddEvent
  1581.     if TextColor   == '' then TextColor = Color.AddEvent
  1582.  
  1583.     if EventType = Event$ then do
  1584.       EnteredDay1 = ConvertDay(EnteredDay1)
  1585.       EnteredDay2 = ConvertDay(EnteredDay2)
  1586.     end
  1587.     else do
  1588.       EnteredDay1 = RootDay + EnteredDay1
  1589.       EnteredDay2 = RootDay + EnteredDay2
  1590.     end
  1591.     if EnteredDay1 > EnteredDay2 then do
  1592.       TempDate = EnteredDay1
  1593.       EnteredDay1 = EnteredDay2
  1594.       EnteredDay2 = TempDate
  1595.     end
  1596.  
  1597.     if pos('B', Options) ~= 0 then Box = 1
  1598.     if pos('W', Options) ~= 0 then Weekly = 1
  1599.     if pos('2', Options) ~= 0 then Weekly = 2
  1600.  
  1601.     /* Process Event */
  1602.     if App == 'PGS' then REFRESH OFF ALL
  1603.  
  1604.     do until Weekly == 0
  1605.       Event = EnteredEvent
  1606.       Line  = EnteredLine
  1607.       Day1  = EnteredDay1
  1608.       Day2  = EnteredDay2
  1609.       Text. = ''
  1610.  
  1611.       if Weekly > 0 then do
  1612.         if Day1 > MaxDate then Weekly = -1
  1613.         if Day2 > MaxDate then Day2 = MaxDate
  1614.       end
  1615.  
  1616.       if Weekly ~= -1 then do
  1617.         If Day1 ~= Day2 then Box = 1
  1618.         LineCount = 0
  1619.         do until Day1 > Day2
  1620.           Day1Row = trunc((Day1 + StartDate - 1) / 7)
  1621.           Day2Row = trunc((Day2 + StartDate - 1) / 7)
  1622.           Day1Column = (Day1 + StartDate) - 7 * Day1Row - 1
  1623.           Day2Column = (Day2 + StartDate) - 7 * Day2Row - 1
  1624.           if (Day1Row == 5) & (DoTopExtraWk == 1) then Day1Row = 0
  1625.           if (Day2Row == 5) & (DoTopExtraWk == 1) then Day2Row = 0
  1626.  
  1627.           if Day1Row == Day2Row then DaySpan = Day2Column - Day1Column + 1
  1628.           else DaySpan = 7 - Day1Column
  1629.           if Day1 < 1 then CalDate = MonthLength.PrevMonth + Day1
  1630.           else if Day1 > MonthLength.Month then CalDate = Day1 - MonthLength.Month
  1631.           else CalDate = Day1
  1632.           if DoDateBox == 1 then HighlightOffset = CurveOffset + 1.25 * DateOffset + 2 * Width.WidthOfDate8
  1633.           else do
  1634.             Select
  1635.               when CalDate < 10 then HighlightOffset = Width.WidthOfDate1 / 2 + Width.WidthOfDate8
  1636.               when CalDate < 20 then HighlightOffset = 1.5 * Width.WidthOfDate1 + Width.WidthOfDate8
  1637.               otherwise HighlightOffset = Width.WidthOfDate1 / 2 + 2 * Width.WidthOfDate8
  1638.             end
  1639.           end
  1640.           HighlightOffset = (1 - Box) * HighlightOffset * (Line * Height.Highlight < Height.Date * TextBase)
  1641.           If Day1Row < 5 then BoxTop = CalTop + Day1Row * BoxHeight
  1642.           else do
  1643.             if DoTopExtraWk ~= 1 then BoxTop = CalTop + 4.5 * BoxHeight
  1644.             else BoxTop = CalTop
  1645.           end
  1646.  
  1647.           LeftEdge = Margin.Left + Day1Column * BoxWidth + CurveOffset + HighlightOffset
  1648.           if event ~= '' then do
  1649.             Textline = 0
  1650.             Text.    = ''
  1651.             Text.Textline = event
  1652.  
  1653.             /* Accomodate user line breaks */
  1654.             do until LineBreak = 0
  1655.               LineBreak = pos('//', Text.Textline)
  1656.               if LineBreak > 0 then do
  1657.                 Nextline = Textline + 1
  1658.                 Text.Nextline = substr(Text.Textline, LineBreak + 2)
  1659.                 Text.Textline = left(Text.Textline, LineBreak - 1)
  1660.                 Textline = Nextline
  1661.               end
  1662.             end
  1663.             Textline = 0
  1664.  
  1665.             /* Fit line(s) into allowable space */
  1666.             do until Text.Nextline == ''
  1667.               Nextline = Textline + 1
  1668.               if Box == 1 | Textline == 0 then Indent.Textline = 0
  1669.               else Indent.Textline = 3 * DateOffset
  1670.               AllowedWidth = DaySpan * BoxWidth - 2 * CurveOffset - Indent.Textline - HighlightOffset - 2 * DateOffset * Box
  1671.               AllowedBoxWidth = AllowedWidth + 2 * CurveOffset
  1672.               if App == 'FW' & length(Text.Textline) > 37 then do
  1673.                 Wordbreak = lastpos(' ', Text.Textline, 37)
  1674.                 Text.Nextline = strip(substr(Text.Textline, Wordbreak)' 'Text.Nextline)
  1675.                 Text.Textline = strip(left(Text.Textline, Wordbreak))
  1676.               end
  1677.               ID = PrintText(1, 1, CurrentFont, 'N', TextColor, Width.CurrentFont, Text.Textline)
  1678.               if App == 'FW' then redraw
  1679.               TextWidth.Textline = GetWidth(ID)
  1680.               if App == 'FW' then DELETEOBJECT ID
  1681.               else if App == 'PGS' then do
  1682.                 SELECTOBJECT OBJECTID ID WINDOW winName
  1683.                 DELETEOBJECT OBJECTID ID WINDOW winName
  1684.               end
  1685.  
  1686.               NeededCompression.Textline = min(1, AllowedWidth/TextWidth.Textline)
  1687.               if (NeededCompression.Textline < MinWidth/100) & (Words(Text.Textline) > 1) then do
  1688.                 /* Move last word to next line */
  1689.                 Wordbreak     = lastpos(' ', Text.Textline)
  1690.                 Text.Nextline = strip(substr(Text.Textline, Wordbreak)' 'Text.Nextline)
  1691.                 Text.Textline = strip(left(Text.Textline, Wordbreak))
  1692.               end
  1693.               else if Text.Nextline ~= '' then Textline = Textline + 1
  1694.             end
  1695.             LineCount = Textline
  1696.           end
  1697.  
  1698.           MaxCompression = 1
  1699.           do i = 0 to LineCount
  1700.             MaxCompression = min(MaxCompression, NeededCompression.i)
  1701.           end
  1702.           TextWidth = MaxCompression * Width.CurrentFont
  1703.           if App == 'FW' then TextWidth = min(max(trunc(TextWidth), 4), 255)
  1704.  
  1705.           if Box then call DrawBox(LeftEdge, BoxTop + Line * Height.Highlight, AllowedBoxWidth, Height.CurrentFont * (LineCount + 1), 'HL', Line.AddEvent, 1, BoxColor, 100)
  1706.           if event ~= '' then do
  1707.             do i = 0 to LineCount
  1708.               Text.Top = BoxTop + (Line + i) * Height.Highlight
  1709.               if Box == 0 then Text.Left = LeftEdge + Indent.i
  1710.               else Text.Left = LeftEdge + (AllowedBoxWidth - TextWidth.i * MaxCompression) / 2
  1711.               call PrintText(Text.Left, Text.Top, CurrentFont, 'N', TextColor, TextWidth, Text.i)
  1712.             end
  1713.           end
  1714.  
  1715.           Day1 = Day1 + DaySpan
  1716.           if Day1 > Day2 then leave
  1717.           else if trunc((Day1 + StartDate - 1) / 7) > 4 & Day2 > MonthLength.Month then Day2 = Day1
  1718.         end
  1719.  
  1720.         if Weekly == 1 then do
  1721.           EnteredDay1 = EnteredDay1 + 7
  1722.           EnteredDay2 = EnteredDay2 + 7
  1723.         end
  1724.         else if Weekly == 2 then do
  1725.           EnteredDay1 = EnteredDay1 + 14
  1726.           EnteredDay2 = EnteredDay2 + 14
  1727.         end
  1728.       end
  1729.       else Weekly = 0
  1730.     end
  1731.     if App == 'FW' then redraw
  1732.     else if App == 'PGS' then SELECTOBJECT None WINDOW winName
  1733.   end
  1734.  
  1735.   call CloseBusy(Req)
  1736.  
  1737.   if App == 'PGS' then do
  1738.     REFRESH ON ALL
  1739.     REFRESHWINDOW WINDOW winName
  1740.     WindowRefreshed = 1
  1741.   end
  1742.  
  1743. return
  1744. /**/
  1745.  
  1746. /***//*** QuoteIt (PROCEDURE) ***/
  1747. QuoteIt: PROCEDURE
  1748.   parse arg String
  1749.  
  1750.   String = strip(String)
  1751.   if (left(String, 1) == '"') & (right(String, 1) == '"') then return String
  1752.   else if (left(String, 1) == "'") & (right(String, 1) == "'") then return String
  1753.   else if pos("'", String) == 0 then return "'"String"'"
  1754.   else return '"'String'"'
  1755.  
  1756.   return
  1757. /**/
  1758.  
  1759. /***//*** ReadBrowserList (RBL) ***/
  1760. ReadBrowserList:
  1761.   parse arg RBL_FileHandle, RBL_GadIDList, RBL_ItemList, RBL_CurrentItem
  1762.  
  1763.   interpret 'RBL_AlreadyOpen = 'RBL_FileHandle
  1764.   if RBL_AlreadyOpen == 0 then do
  1765.     call ToPIPE(RBL_FileHandle, 'open')
  1766.     if RBL_CurrentItem ~= '' then call ToPIPE(RBL_FileHandle, 'id 1 s='MemberID(RBL_CurrentItem, RBL_ItemList) + 2)
  1767.     interpret RBL_FileHandle '= 1'
  1768.   end
  1769.   else do
  1770.     if RBL_CurrentItem ~= '' then call ToPIPE(RBL_FileHandle, 'id 1 s='MemberID(RBL_CurrentItem, RBL_ItemList) + 2)
  1771.     call ToPIPE(RBL_FileHandle, 'id 0 s=64')
  1772.   end
  1773.  
  1774.   do while ~eof(RBL_FileHandle)
  1775.     call ToPIPE(RBL_FileHandle, 'continue')
  1776.     RBL_Result = readln(RBL_FileHandle)
  1777.     parse var RBL_Result . . . . RBL_NodeID
  1778.     RBL_NodeID = strip(RBL_NodeID)
  1779.     interpret 'RBL_ListID = 'RBL_GadIDList'.RBL_NodeID'
  1780.     if pos('gadget', RBL_Result) > 0 then leave
  1781.   end
  1782.   call ToPIPE(RBL_FileHandle, 'id 0 s=128')
  1783.   interpret 'RBL_Entry = 'RBL_ItemList'.'RBL_ListID
  1784.   return RBL_Entry
  1785. /**/
  1786.  
  1787. /***//*** ReadFile (PROCEDURE) Subroutine ***/
  1788. ReadFile: PROCEDURE
  1789.   parse arg file
  1790.  
  1791.   if open('Temp', file) then do
  1792.     val = strip(readch('Temp', 65535), 'B', ' '||'0a'x)
  1793.     call close('Temp')
  1794.   end
  1795.   else val = ''
  1796.   return val
  1797. /**/
  1798.  
  1799. /***//*** ReadToEOL (PROCEDURE) Subroutine ***/
  1800. ReadToEOL: PROCEDURE
  1801.   parse arg Start, Var
  1802.  
  1803.   if Start == 0 then return ''
  1804.  
  1805.   EOL = pos('0a'x, Var, Start)
  1806.   if EOL == 0 then EOL = length(Var)
  1807.  
  1808.   return substr(Var, Start, EOL - Start)
  1809. /**/
  1810.  
  1811. /***//*** Syntax () Subroutine ***/
  1812. Syntax:
  1813.   signal off syntax
  1814.  
  1815.   ErrorLine  = SIGL
  1816.   SourceLine = strip(SourceLine(ErrorLine))
  1817.  
  1818.   call AddMsg('E', 'Error 'RC' ('errortext(RC)')')
  1819.   call AddMsg('E', 'Line 'ErrorLine': 'SourceLine)
  1820.   call AddMsg('E', ParseVariables(SourceLine))
  1821.  
  1822.   call Cleanup
  1823.   exit
  1824. /**/
  1825.  
  1826. /***//*** ToPIPE (TP) ***/
  1827. ToPIPE:
  1828.   parse arg PipeName, TP_CMD
  1829.  
  1830.   call writeln(PipeName,' 'TP_CMD)
  1831.   TP_Response=readln(PipeName)
  1832.  
  1833.   parse var TP_Response TP_Response1 TP_Response2 .
  1834.  
  1835.   if TP_Response1 == 'ok' then return(TP_Response2)
  1836.   if TP_Response == '' then TP_Response = 'Blank line'
  1837.   call AddMsg('E', 'Line : 'SIGL)
  1838.   call AddMsg('E', PipeName' error: 'TP_Response)
  1839.   call AddMsg('E', 'Returned from: 'TP_CMD)
  1840.   call Cleanup
  1841. /**/
  1842.  
  1843. /***//*** TranslationStrings () ***/
  1844. TranslationStrings:
  1845. Sunday$    = 'Sunday'
  1846. Monday$    = 'Monday'
  1847. Tuesday$   = 'Tuesday'
  1848. Wednesday$ = 'Wednesday'
  1849. Thursday$  = 'Thursday'
  1850. Friday$    = 'Friday'
  1851. Saturday$  = 'Saturday'
  1852.  
  1853. January$   = 'January'
  1854. February$  = 'February'
  1855. March$     = 'March'
  1856. April$     = 'April'
  1857. May$       = 'May'
  1858. June$      = 'June'
  1859. July$      = 'July'
  1860. August$    = 'August'
  1861. September$ = 'September'
  1862. October$   = 'October'
  1863. November$  = 'November'
  1864. December$  = 'December'
  1865.  
  1866. AddEvent$       = 'Add Event'
  1867. AddIC$          = '+IC'
  1868. All$            = 'All'
  1869. BiOrWeekly$     = '(Bi)Weekly'
  1870. Biweekly$       = 'Biweekly'
  1871. Bottom$         = 'Bottom'
  1872. BoxColor$       = 'Box'
  1873. BoxDates$       = 'Box Dates'
  1874. Boxed$          = '_Boxed'
  1875. Calendar$       = 'Calendar'
  1876. Calendars$      = 'Calendars'
  1877. Cancel$         = '_Cancel'
  1878. CantFind$       = "can't be found"
  1879. Center$         = 'Center'
  1880. Clear$          = 'Clear'
  1881. Color$          = 'Color'
  1882. Colors$         = 'Colors'
  1883. Comment$        = 'Comment'
  1884. Critical$       = 'Critical error'
  1885. DailyColors$    = 'Use daily colors'
  1886. DeleteEvent$    = 'Delete Event'
  1887. Done$           = 'Done'
  1888. Easter$         = 'Easter'
  1889. End$            = 'End'
  1890. EnterEvent$     = 'You must enter an event...'
  1891. EnterEventInfo$ = 'Enter event information'
  1892. EnterNewIC$     = 'Enter new ImageClass'
  1893. EnterStartdate$ = 'You must enter a start date...'
  1894. Even$           = 'Even'
  1895. Event$          = 'Event'
  1896. Extended$       = 'Extended'
  1897. File$           = 'File'
  1898. First$          = 'First'
  1899. Fixed$          = 'Fixed'
  1900. Floating$       = 'Floating'
  1901. Font$           = 'Font'
  1902. Fonts$          = 'Fonts'
  1903. ForDetails$     = 'for details'
  1904. ForwardContent$ = 'Forward contents of output to'
  1905. ForwardLog$     = 'Forward log file to'
  1906. Fourth$         = 'Fourth'
  1907. Frequency$      = 'Frequency'
  1908. GeneratingM$    = 'Generating %s %s calendar'
  1909. GeneratingY$    = 'Generating %s calendar'
  1910. Go$             = 'Go'
  1911. Header$         = '%s %s'
  1912. HighlightEd$    = 'Highlight Editor'
  1913. Highlights$     = 'Highlights'
  1914. History$        = 'History'
  1915. Holiday$        = 'Holiday'
  1916. Images$         = 'Images'
  1917. Julian$         = 'Julian'
  1918. JulJulLeft$     = 'Jul/Jul Left'
  1919. JulLeft$        = 'Jul Left'
  1920. Last$           = 'Last'
  1921. Left$           = 'Left'
  1922. Line$           = '_Line'
  1923. Load$           = '_Load'
  1924. MatchColors$    = 'Date Color = Highlight Color'
  1925. MiniCals$       = 'MiniCals'
  1926. MiscVar$        = 'Miscellaneous Variables'
  1927. MultiMonth$     = 'Multi-Month'
  1928. MustUse$        = 'You must use the gadget to'||'0a'x||'the right for this value.'
  1929. NextDay$        = 'Next day'
  1930. Noncritical$    = 'Noncritical warning'
  1931. None$           = 'None'
  1932. NotClear$       = '<'Clear$'> can only be used for "Background." variables...'
  1933. Note$           = 'Notes'
  1934. NoteBox$        = 'Note box'
  1935. Notice$         = 'notice'
  1936. Odd$            = 'Odd'
  1937. OK$             = '_OK'
  1938. OK2$            = 'OK'
  1939. Once$           = 'Once'
  1940. Options$        = 'Options'
  1941. OptLayout$      = 'Options & Layout'
  1942. OrientMarg$     = 'Orientation & Margins'
  1943. Phases$         = 'Phases'
  1944. PleaseWait$     = 'please wait'
  1945. PrepReq$        = 'Preparing requester'
  1946. PreviousDay$    = 'Prev day'
  1947. ProcessEvents$  = 'Processing events'
  1948. Random$         = 'Random'
  1949. Reset$          = '_Reset'
  1950. Right$          = 'Right'
  1951. RiseSet$        = 'Rise/Set'
  1952. SaveAs$         = '_Save as'
  1953. Second$         = 'Second'
  1954. See$            = 'see'
  1955. SeeOutput$      = 'see the output above for details'
  1956. SeeShell$       = 'see the shell output for details'
  1957. SelectApp$      = 'Select application'
  1958. SelectFile$     = 'Select data file'
  1959. SelectFont$     = 'Select font'
  1960. SelectImage$    = 'Select image'
  1961. SelectPrefs$    = 'Select name for prefs file'
  1962. SingleMonth$    = 'Single Month'
  1963. Start$          = 'Start'
  1964. SubHeader$      = ''
  1965. Sunrise$        = 'Sunrise'
  1966. Sunset$         = 'Sunset'
  1967. Tall$           = 'Tall'
  1968. TextColor$      = 'Text'
  1969. Third$          = 'Third'
  1970. Top$            = 'Top'
  1971. TopLong$        = 'Extra week at top'
  1972. Type$           = 'Type'
  1973. Unable$         = 'if you are unable to resolve the problem.'
  1974. VarGUITitle$    = 'Set desired variables'
  1975. Variables$      = 'Variables'
  1976. Weekend$        = 'Weekend'
  1977. Weekly$         = 'Weekly'
  1978. WeekNumber$     = 'Week Number'
  1979. WeekType$       = 'Week Type'
  1980. WholeYear$      = 'Whole Year'
  1981. Wide$           = 'Wide'
  1982.  
  1983. Help$                       = 'Help message'
  1984. Help$.ClickTabHelp          = 'Different tabs display*ndifferent variables'
  1985. Help$.MiniCalsGadHelp       = 'Include mini-calendars showing*nthe previous & next months'
  1986. Help$.HighlightsGadHelp     = 'Include highlights on*nthe generated calendar'
  1987. Help$.ImagesGadHelp         = 'Include images on*nthe generated calendar'
  1988. Help$.BoxDatesGadHelp       = 'Surround day numbers*nwith boxes'
  1989. Help$.ExtendedGadHelp       = 'Include days from the previous*nand next months on the*ngenerated calendar'
  1990. Help$.TopLongGadHelp        = 'Include days from the sixth week*nat the top of the calendar'
  1991. Help$.NoteBoxGadHelp        = 'Include an area to write notes*nwhere no dates are printed'
  1992. Help$.TopMargGadHelp        = "Set calendar's top margin*nRemember to <RETURN>"
  1993. Help$.LeftMargGadHelp       = "Set calendar's left margin*nRemember to <RETURN>"
  1994. Help$.OrientationGadHelp    = "Set calendar's orientation"
  1995. Help$.RightMargGadHelp      = "Set calendar's right margin*nRemember to <RETURN>"
  1996. Help$.BottomMargGadHelp     = "Set calendar's bottom margin*nRemember to <RETURN>"
  1997. Help$.FontVarGadHelp        = 'Select the font variable to set'
  1998. Help$.FontValGadHelp        = 'Displays the choosen font value'
  1999. Help$.ChooseFontGadHelp     = 'Select the desired font'
  2000. Help$.ColorVarGadHelp       = 'Select the color variable to set'
  2001. Help$.CycleColorVarGadHelp  = 'Cycle through the color variables*nShift to reverse cycle'
  2002. Help$.ColorValGadHelp       = 'Select the desired color'
  2003. Help$.MatchColorsGadHelp    = 'Use the highlight text color*nfor the date/date box'
  2004. Help$.DailyColorsGadHelp    = 'Use the Color.(Weekday) colors*nfor the date/date box'
  2005. Help$.HighlightEditGadHelp  = 'Bring up the*nHighlight Editor'
  2006. Help$.MiscVarGadHelp        = 'Select the desired*nmiscellaneous variable'
  2007. Help$.CycleMiscVarGadHelp   = 'Cycle through the miscellaneous variables*nShift to reverse cycle'
  2008. Help$.MiscValGadHelp        = 'Enter the desired variable value'
  2009. Help$.ChooseValGadHelp      = 'Used only for selecting files/paths'
  2010. Help$.AddImageClassGadHelp  = 'Add an ImageClass variable'
  2011. Help$.Extra3Help            = "Select extra to be printed*nin calendar's top-center"
  2012. Help$.Extra4Help            = "Select extra to be printed*nin calendar's top-right"
  2013. Help$.Extra0Help            = "Select extra to be printed*nin calendar's bottom-left"
  2014. Help$.Extra1Help            = "Select extra to be printed*nin calendar's bottom-center"
  2015. Help$.Extra2Help            = "Select extra to be printed*nin calendar's bottom-right"
  2016. Help$.CalendarTypeGadHelp   = 'Select calendar type'
  2017. Help$.EndMonthGadHelp       = 'Select desired end month'
  2018. Help$.StartMonthGadHelp     = 'Select desired start month'
  2019. Help$.MonthGadHelp          = 'Select desired month'
  2020. Help$.YearGadHelp           = 'Select or enter desired year'
  2021. Help$.GoGadHelp             = 'Begin generation of calendar'
  2022. Help$.ResetGadHelp          = 'Reset all variables to defaults'
  2023. Help$.LoadGadHelp           = 'Load a new preference file'
  2024. Help$.SaveAsGadHelp         = 'Save current settings to*na new preference file'
  2025. Help$.CancelGadHelp         = 'Cancel FWCalendar'
  2026. Help$.EH_EventGadHelp       = 'Enter the Highlight as it*nwill show up on calendar'
  2027. Help$.EH_ChooseEventGadHelp = 'Select Image file to be printed on calendar'
  2028. Help$.EH_ListEventGadHelp   = 'List all Highlights*nfor current month'
  2029. Help$.EH_CycleEventGadHelp  = 'Cycle through all Highlights*nfor current month'
  2030. Help$.EH_CommentGadHelp     = 'Enter optional comment'
  2031. Help$.EH_MonthGadHelp       = 'Select month to work with'
  2032. Help$.ExtraDHelp            = 'Select the date on*nwhich the Highlight falls'
  2033. Help$.LD                    = 'Indicates the Highlight always falls*non the last day of the month'
  2034. Help$.EH_ColorGadHelp       = 'Select color to be*nused for the Highlight'
  2035. Help$.EH_HLTypeGadHelp      = 'Select the Highlight type'
  2036. Help$.EH_WeekNumberGadHelp  = 'Select which week a floating*nHighlight occurs in'
  2037. Help$.EH_WeekTypeGadHelp    = 'Select frequency of weekly Highlights'
  2038. Help$.EH_WeekendGadHelp     = 'Determine whether or not the*nHighlight can fall on a weekend'
  2039. Help$.EH_HolidayGadHelp     = 'Treat the Highlight as a holiday'
  2040. Help$.EH_EasterGadHelp      = 'The number of days before or*nafter Easter for the Highlight'
  2041. Help$.EH_AddEventGadHelp    = 'Add a new Highlight'
  2042. Help$.EH_DeleteEventGadHelp = 'Delete the currently*ndisplayed Highlight'
  2043. Help$.EH_DoneGadHelp        = 'Save all changes to Highlights'
  2044. Help$.GE_EventTypeGadHelp   = 'Select to enter Event or*nuse an Event file'
  2045. Help$.GE_EventGadHelp       = 'Enter Event or display Event file'
  2046. Help$.GE_FontNameGadHelp    = 'Display font to be used'
  2047. Help$.GE_FontSizeGadHelp    = 'Enter font size to use'
  2048. Help$.GE_ChooseFontGadHelp  = 'Select font to be used'
  2049. Help$.GE_ResetGadHelp       = 'Reset font and font size'
  2050. Help$.GadIDHelp             = 'Enter Event start and end dates'
  2051. Help$.GE_StartGadHelp       = 'Display Event start date'
  2052. Help$.GE_EndGadHelp         = 'Display Event end date'
  2053. Help$.GE_TextColorGadHelp   = 'Select color to be*nused for Event text'
  2054. Help$.GE_LineGadHelp        = 'Select row on which*nEvent will be printed'
  2055. Help$.GE_BoxedGadHelp       = 'Surround Event with a box'
  2056. Help$.GE_BoxColorGadHelp    = 'Select color for box*nsurrounding Event'
  2057. Help$.GE_FrequencyGadHelp   = 'Select frequency of Event'
  2058. Help$.GE_OKGadHelp          = 'Use entered data to add*nEvent to calendar'
  2059. Help$.GE_CancelGadHelp      = 'Cancel FWCAddEvent'
  2060.  
  2061. return 0
  2062. /**/
  2063.  
  2064. /***//*** VIO Routines () Subroutine ***/
  2065. /***//** OpenV() **/
  2066. OpenV:
  2067.   parse arg VIO_Variable
  2068.  
  2069.   if Open.VIO_Variable ~= 1 then do
  2070.     Open.VIO_Variable = 1
  2071.     Pointer.VIO_Variable = 1
  2072.     EOF.VIO_Variable = 0
  2073.     return 1
  2074.   end
  2075.   else return 0
  2076. /**/
  2077.  
  2078. /***//** CloseV() **/
  2079. CloseV:
  2080.   parse arg VIO_Variable
  2081.  
  2082.   If Open.VIO_Variable == 0 then return 0
  2083.   Open.VIO_Variable = 0
  2084.   return 1
  2085. /**/
  2086.  
  2087. /***//** SeekV() **/
  2088. SeekV:
  2089.   parse arg VIO_Variable, VIO_Offset, VIO_Anchor
  2090.  
  2091.   if Open.VIO_Variable == 1 then do
  2092.     VIO_Anchor = upper(left(VIO_Anchor, 1))
  2093.  
  2094.     VIO_Value = Value(VIO_Variable)
  2095.     select
  2096.       when VIO_Anchor == 'B' then Pointer.VIO_Variable = VIO_Offset
  2097.       when VIO_Anchor == 'E' then Pointer.VIO_Variable = length(VIO_Value) + VIO_Offset
  2098.       otherwise Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Offset
  2099.     end
  2100.  
  2101.     if Pointer.VIO_Variable > length(VIO_Value) then Pointer.VIO_Variable = length(VIO_Value) + 1
  2102.     return Pointer.VIO_Variable
  2103.   end
  2104.   else return 0
  2105. /**/
  2106.  
  2107. /***//** ReadVCh() **/
  2108. ReadVCh:
  2109.   parse arg VIO_Variable, VIO_Length
  2110.  
  2111.   if VIO_Length == '' then VIO_Length = 1
  2112.  
  2113.   if Open.VIO_Variable == 1 then do
  2114.     if EOF.VIO_Variable == 0 then do
  2115.       VIO_Value = Value(VIO_Variable)
  2116.       VIO_Ret = substr(VIO_Value, Pointer.VIO_Variable, VIO_Length)
  2117.       Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Length
  2118.       if Pointer.VIO_Variable > length(VIO_Value) then EOF.VIO_Variable = 1
  2119.       else EOF.VIO_Variable = 0
  2120.     end
  2121.     else VIO_Ret = ''
  2122.   end
  2123.   else VIO_Ret = ''
  2124.  
  2125.   return VIO_Ret
  2126. /**/
  2127.  
  2128. /***//** ReadVLn(RV) **/
  2129. ReadVLn:
  2130.   parse arg VIO_Variable, VIO_Count, VIO_SepChar
  2131.  
  2132.   if VIO_Count == '' then VIO_Count = 1
  2133.   if VIO_SepChar == '' then VIO_SepChar = '0a'x
  2134.  
  2135.   if Open.VIO_Variable == 1 then do
  2136.     VIO_Value = Value(VIO_Variable)
  2137.     VIO_Ret   = ''
  2138.     do VIO_i = 1 to VIO_Count
  2139.       VIO_LF = pos('0a'x, VIO_Value, Pointer.VIO_Variable)
  2140.       if VIO_LF > 0 then do
  2141.         VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable, VIO_LF - Pointer.VIO_Variable)
  2142.         Pointer.VIO_Variable = VIO_LF + 1
  2143.         if VIO_LF = length(VIO_Value) then EOF.VIO_Variable = 1
  2144.         else EOF.VIO_Variable = 0
  2145.       end
  2146.       else do
  2147.         if Pointer.VIO_Variable < length(VIO_Value) then do
  2148.           VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable)
  2149.           Pointer.VIO_Variable = length(VIO_Value) + 1
  2150.           EOF.VIO_Variable = 1
  2151.         end
  2152.       end
  2153.       if EOF.VIO_Variable == 1 then leave
  2154.       if VIO_i ~= VIO_Count then VIO_Ret = VIO_Ret''VIO_SepChar
  2155.     end
  2156.   end
  2157.   else VIO_Ret = ''
  2158.  
  2159.   return VIO_Ret
  2160. /**/
  2161.  
  2162. /***//** WriteVCh() **/
  2163. WriteVCh:
  2164.   parse arg VIO_Variable, VIO_String, VIO_Option
  2165.  
  2166.   VIO_Value  = Value(VIO_Variable)
  2167.   VIO_Option = upper(left(VIO_Option, 1))
  2168.   VIO_Length = length(VIO_Value)
  2169.   if VIO_Option == 'C' then do
  2170.     VIO_Value = Insert(VIO_String, VIO_Value, Pointer.VIO_Variable - 1)
  2171.     Pointer.VIO_Variable = Pointer.VIO_Variable + length(VIO_String)
  2172.   end
  2173.   else if VIO_Option == 'B' then do
  2174.     VIO_Value = VIO_String''VIO_Value
  2175.     Pointer.VIO_Variable = length(VIO_String) + 1
  2176.   end
  2177.   else do
  2178.     VIO_Value = VIO_Value''VIO_String
  2179.     Pointer.VIO_Variable = length(VIO_Value)
  2180.   end
  2181.   interpret VIO_Variable'= VIO_Value'
  2182.   if length(VIO_Value) = VIO_Length + length(VIO_String) then VIO_Ret = length(VIO_String)
  2183.   else VIO_Ret = 0
  2184.  
  2185.   return VIO_Ret
  2186. /**/
  2187.  
  2188. /***//** WriteVLn() **/
  2189. WriteVLn:
  2190.   parse arg VIO_Variable, VIO_String, VIO_Option
  2191.  
  2192.   return WriteVCh(VIO_Variable, VIO_String||'0a'x, VIO_Option)
  2193. /**/
  2194.  
  2195. /***//** EOFV() **/
  2196. EOFV:
  2197.   parse arg VIO_Variable
  2198.  
  2199.   if Open.VIO_Variable == 1 then return EOF.VIO_Variable
  2200.   else return 1
  2201. /**/
  2202. /**/
  2203.  
  2204. /***//*** WriteFile (PROCEDURE) Subroutine ***/
  2205. WriteFile: PROCEDURE
  2206.   parse arg file, var, which
  2207.  
  2208.   if open('Temp', file, 'W') then do
  2209.     success = writech('Temp', var)
  2210.     call close('Temp')
  2211.   end
  2212.   if (upper(which) == 'B') & (upper(left(file, 4)) == 'ENV:') then call WriteFile('ENVARC:'substr(file, 5), var)
  2213.  
  2214.   return success
  2215. /**/
  2216.  
  2217. /***//*** SetVariables Subroutine ***/
  2218. SetVariables:
  2219. /***//**** Initialize Variables ****/
  2220.   Date            = 0
  2221.   esc             = "1B"x
  2222.   EventFile       = ''
  2223.   FontKnown.      = ''
  2224.   FSize.          = 10
  2225.   HighestFont     = 5
  2226.   Highlight       = 5
  2227.   PatVar          = '#?.data'
  2228.   PrefsFile       = ''
  2229.   Req             = 0
  2230.   Storage         = 'RAM:FWC/'
  2231.   Width.          = 100
  2232.   ColorW          = 80
  2233.   ColorH          = 10
  2234.  
  2235.   if App == 'FW' then DefaultFont = "SoftSans"
  2236.   else if App == 'PGS' then DefaultFont = 'PageStream-Normal'
  2237.  
  2238.   D.0 = 'Sunday'
  2239.   D.1 = 'Monday'
  2240.   D.2 = 'Tuesday'
  2241.   D.3 = 'Wednesday'
  2242.   D.4 = 'Thursday'
  2243.   D.5 = 'Friday'
  2244.   D.6 = 'Saturday'
  2245.  
  2246.   MonthLength.1    = 31
  2247.   MonthLength.2    = 28
  2248.   MonthLength.3    = 31
  2249.   MonthLength.4    = 30
  2250.   MonthLength.5    = 31
  2251.   MonthLength.6    = 30
  2252.   MonthLength.7    = 31
  2253.   MonthLength.8    = 31
  2254.   MonthLength.9    = 30
  2255.   MonthLength.10   = 31
  2256.   MonthLength.11   = 30
  2257.   MonthLength.12   = 31
  2258.  
  2259.   Month.1  = January$
  2260.   Month.2  = February$
  2261.   Month.3  = March$
  2262.   Month.4  = April$
  2263.   Month.5  = May$
  2264.   Month.6  = June$
  2265.   Month.7  = July$
  2266.   Month.8  = August$
  2267.   Month.9  = September$
  2268.   Month.10 = October$
  2269.   Month.11 = November$
  2270.   Month.12 = December$
  2271. /**/
  2272.  
  2273. /***//**** Read default variables ****/
  2274.   call open('Temp', FullCallPath)
  2275.     call seek('Temp', -5000, 'E')
  2276.     Chunk = readch('Temp', 65535)
  2277.     EndPos = pos('VarList:'||'0a'x, Chunk)
  2278.     if EndPos == 0 then do
  2279.       call AddMsg('E', 'Unable to locate default variables.')
  2280.       call CleanUp
  2281.     end
  2282.     RD_VariableFile = substr(Chunk, EndPos + 9)
  2283.   call close('Temp')
  2284.   interpret left(RD_VariableFile, pos('return', RD_VariableFile) - 1)
  2285. /**/
  2286.  
  2287. /***//**** Determine prefs file from calendar ****/
  2288.   if App == 'FW' then do
  2289.     FIRSTOBJECT; TempDateID = result
  2290.     do forever
  2291.       if TempDateID == 0 then do
  2292.         call AddMsg('E', 'Unable to find FWC date string.')
  2293.         call AddMsg('E', 'Make sure a Monthly calendar created by FWCalendar.rexx is currently loaded.')
  2294.         call Cleanup
  2295.       end
  2296.       GETOBJECTTYPE TempDateID; ObjectType = result
  2297.       if ObjectType == 7 then do
  2298.         GETTEXTBLOCKTEXT TempDateID; TempDate = result
  2299.         if (left(TempDate, 3) == 'FWC') & (datatype(substr(TempDate, 4, 8)) == 'NUM') then leave
  2300.       end
  2301.       NEXTOBJECT TempDateID; TempDateID = result
  2302.     end
  2303.     do while right(TempDate, 1) == '|'
  2304.       StartObj = pos('|', TempDate)
  2305.       NextObj = strip(substr(TempDate, StartObj), 'B', '|')
  2306.       GETTEXTBLOCKTEXT NextObj; NextPart = result
  2307.       TempDate = left(TempDate, StartObj - 1)''NextPart
  2308.     end
  2309.   end
  2310.   else if App = 'PGS' then do
  2311.     CURRENTWINDOW; winName = '"'RESULT'"'
  2312.     SELECTTEXT at 0 0 WINDOW winName
  2313.     SELECTTEXT ALL WINDOW winName
  2314.     EXPORTTEXT AMIGA FILE "PIPE:FWC" FILTER "ASCII" STATUS FORCE
  2315.     TempDate = ReadFile("PIPE:FWC")
  2316.     SENDTOBACK WINDOW winName
  2317.     if (left(TempDate, 3) ~= 'FWC') | (datatype(substr(TempDate, 4, 8)) ~= 'NUM') then do
  2318.       call AddMsg('E', 'Unable to find FWC date string.')
  2319.       call AddMsg('E', 'Make sure a Monthly calendar created by FWCalendar.rexx is currently loaded.')
  2320.       call Cleanup
  2321.     end
  2322.     else do
  2323.       do while right(TempDate, 1) == '|'
  2324.         StartPointer = pos('|', TempDate)
  2325.         SELECTTEXT at 0 0 WINDOW winName
  2326.         SELECTTEXT ALL WINDOW winName
  2327.         EXPORTTEXT AMIGA FILE "PIPE:FWC" FILTER "ASCII" STATUS FORCE
  2328.         TempDate = left(TempDate, StartPointer - 1)''readfile("PIPE:FWC")
  2329.         SENDTOBACK WINDOW winName
  2330.       end
  2331.     end
  2332.   end
  2333.   PrefsFile = substr(TempDate, 12)
  2334.   TempDate = substr(TempDate, 4, 8)
  2335. /**/
  2336.  
  2337. /***//**** Get application colors ****/
  2338.   if App == 'FW' then do
  2339.     FWPrefs = ReadFile(CurrentDir'FWFiles/FW.Prefs')
  2340.     ColorTable = pos('SWCL', FWPrefs) + 12
  2341.     EndTable = pos('STUP', FWPrefs)
  2342.     ColorCount = 0
  2343.     Do CTPos = ColorTable to EndTable by 20
  2344.       ColorRegister.ColorCount = c2x(substr(FWPrefs, CTPos - 3, 3))
  2345.       ColorList.ColorCount = strip(substr(FWPrefs, CTPos, 16), 'B', '00'x)
  2346.       if ColorRegister.ColorCount = '000000' then Black$ = ColorList.ColorCount
  2347.       if ColorRegister.ColorCount = 'FFFFFF' then White$ = ColorList.ColorCount
  2348.       ColorCount = ColorCount + 1
  2349.     end
  2350.     ColorList.ColorCount = '<'Clear$'>'
  2351.     ColorCount = ColorCount + 1
  2352.     ColorList.COUNT = ColorCount
  2353.     if symbol('Black$') == 'LIT' then do
  2354.       call AddMsg('W', "The color black can't be found; "ColorList.0" used instead.")
  2355.       Black$ = ColorList.0
  2356.     end
  2357.     if symbol('White$') == 'LIT' then do
  2358.       call AddMsg('W', "The color white can't be found; "ColorList.1" used instead.")
  2359.       White$ = ColorList.1
  2360.     end
  2361.   end
  2362.   else if App == 'PGS' then do
  2363.     GETFONTLIST FontList
  2364.     FontList.COUNT = result
  2365.  
  2366.     PGSColors = ReadFile(CurrentDir''word(PgmVersion, 1)'.colors')
  2367.     ColorCount = 0
  2368.     StartTag = pos('TG'||'00'x, PGSColors)
  2369.     do while StartTag ~= 0
  2370.       Color = substr(PGSColors, StartTag + 10, c2d(substr(PGSColors, StartTag + 9, 1)))
  2371.       AccentMarker = pos(d2c(129), Color)
  2372.       do while AccentMarker > 0
  2373.         Color = overlay(d2c(c2d(substr(Color, AccentMarker + 1, 1)) + 128), delstr(Color, AccentMarker, 1), AccentMarker)
  2374.         AccentMarker = pos(d2c(129), Color)
  2375.       end
  2376.       ColorList.ColorCount = Color
  2377.       ColorCount = ColorCount + 1
  2378.       StartTag = pos('TG'||'00'x, PGSColors, StartTag + 10)
  2379.     end
  2380.     ColorList.ColorCount = '<'Clear$'>'
  2381.     ColorCount = ColorCount + 1
  2382.     ColorList.COUNT = ColorCount
  2383.     White$ = ColorList.0
  2384.     Black$ = ColorList.1
  2385.   end
  2386.   TextColorList.Count = ColorList.COUNT - 1
  2387.  
  2388.   do i = 0 to TextColorList.Count - 1
  2389.     TextColorList.i = ColorList.i
  2390.   end
  2391.  
  2392.   Color.          = Black$
  2393.   Line.           = Black$
  2394.   Background.     = White$
  2395. /**/
  2396.  
  2397.   GSI_Data = ReadFile(PrefsFile)
  2398.   if GSI_Data ~= '' then do
  2399.     GSI_UpperData = upper(GSI_Data)
  2400.     interpret ReadToEOL(pos('STORAGE', GSI_UpperData), GSI_UpperData)
  2401.     interpret ReadToEOL(pos('FORCEBGUI', GSI_UpperData), GSI_UpperData)
  2402.     interpret ReadToEOL(pos('HOSTSCREEN', GSI_UpperData), GSI_UpperData)
  2403.  
  2404.     if ForceBGUI == 1 then call AddBGUI
  2405.     if HostScreen ~= '' then AppScreen = HostScreen
  2406.   end
  2407.   address command 'makedir >NIL: 'left(Storage, length(Storage) - 1)
  2408.  
  2409.   if (PrefsFile ~= 'Default') & (exists(PrefsFile)) then do
  2410.     UserFile = ReadFile(PrefsFile)
  2411.     if UserFile ~= '' then do
  2412.       call openv('UserFile')
  2413.         do until eofv('UserFile')
  2414.           CD_VarLine = strip(ReadvLn('UserFile'))
  2415.           if left(CD_VarLine, 15) == '/* End Pass One' then leave
  2416.           if upper(left(CD_VarLine, 11)) == 'IMAGECLASS.' then iterate
  2417.           interpret CD_VarLine
  2418.         end
  2419.       call closev('UserFile')
  2420.     end
  2421.   end
  2422.   drop Orientation
  2423.  
  2424.   Type.0    = Event$
  2425.   Type.1    = File$
  2426.   FSize.4pt = 4
  2427.  
  2428.   CalendarBorder = CalendarBorder / 100
  2429.   CalendarShadow = CalendarShadow / 100
  2430.   CornerRadius   = CornerRadius / 100
  2431.   DateOffset     = DateOffset / 100
  2432.   StretchDateH   = StretchDateH / 100
  2433.   StretchDateW   = StretchDateW / 100
  2434.   TextAdj        = TextAdj / 100
  2435.   TTextArea      = TTextArea / 100
  2436.   WTextArea      = WTextArea / 100
  2437.  
  2438.   do i = 0 to 6
  2439.     val = i - StartWeek
  2440.     if val < 0 then val = 7 + val
  2441.     interpret 'Day.'D.i '=' val
  2442.     interpret 'Day.val = 'D.i'$'
  2443.   end
  2444.  
  2445.   if App == 'FW' then do
  2446.     TextBase = TextAdj
  2447.     do i = 0 to 5 by 5
  2448.       if Font.i == NameOnly(Font.i) then Font.i = CurrentDir'FWFonts/SWOLFonts/'Font.i
  2449.       if ~exists(Font.i) then do
  2450.         call AddMsg('W', NameOnly(Font.i)" can't be found; "DefaultFont" used instead.")
  2451.         Font.i = DefaultFont
  2452.       end
  2453.     end
  2454.     GETPAGESETUP ORIENT; FWC_Orientation = result
  2455.     if FWC_Orientation == 'Wide' then TextArea = WTextArea
  2456.     else TextArea = TTextArea
  2457.  
  2458.     GETDISPLAYPREFS Measure; UserPrefs = 'DISPLAYPREFS Measure 'result
  2459.     DISPLAYPREFS Measure Inches
  2460.     GETSECTIONSETUP Top Bottom Inside Outside
  2461.     parse var result Margin.Top Margin.Bottom Margin.Left Margin.Right
  2462.  
  2463.     GETPAGESETUP Width Height
  2464.     parse var result FullWidth FullHeight
  2465.  
  2466.     TextBlockPrefs TEXTFLOW None
  2467.   end
  2468.   else if App = 'PGS' then do
  2469.     TextBase = 1
  2470.     GETFONTLIST FontNames
  2471.     FontNames.COUNT = result
  2472.     do i = 0 to 5 by 5
  2473.       do j = 0 to FontNames.COUNT - 1
  2474.         if upper(Font.i) == upper(FontNames.j) then leave
  2475.       end
  2476.       if j == FontNames.COUNT then do
  2477.         call AddMsg('W', Font.i" can't be found; "DefaultFont" used instead.")
  2478.         Font.i = DefaultFont
  2479.       end
  2480.     end
  2481.     GETMASTERPAGES MPage; PageName = MPage.0
  2482.     GETMEASUREMENTS COORDINATE stemc RELATIVE rel TEXT tex FROM fro
  2483.     UserPrefs = 'SETMEASUREMENTS COORDINATE 'stemc.horizontal stemc.vertical' RELATIVE 'rel' TEXT 'tex' FROM 'fro
  2484.     SETMEASUREMENTS COORDINATE Inches Sameas RELATIVE Sameas TEXT Points FROM Page
  2485.     GETMARGINGUIDES temp
  2486.     Margin.Left   = temp.inside
  2487.     Margin.Right  = temp.outside
  2488.     Margin.Top    = temp.top
  2489.     Margin.Bottom = temp.bottom
  2490.  
  2491.     GETDIMENSIONS layout MASTERPAGE "'"PageName"'"
  2492.     if layout.orientation == 'LANDSCAPE' then do
  2493.       TextArea   = WTextArea
  2494.       FullWidth  = layout.height
  2495.       FullHeight = layout.width
  2496.     end
  2497.     else do
  2498.       TextArea   = TTextArea
  2499.       FullWidth  = layout.width
  2500.       FullHeight = layout.height
  2501.     end
  2502.   end
  2503.   PrintWidth       = FullWidth - Margin.Left - Margin.Right
  2504.   PrintHeight      = FullHeight - Margin.Top - Margin.Bottom
  2505.  
  2506.   if App == 'FW' then do
  2507.     GETOBJECTCOORDS TempDateID; Parse Var result . . . . Height.4pt
  2508.   end
  2509.   else if App == 'PGS' then Height.4pt = GetHeight(4pt)
  2510.   if ((PrintHeight - Height.4pt - (TextArea * PrintHeight))/5 * 8) >= 4 then
  2511.       PrintHeight = PrintHeight - Height.4pt
  2512.  
  2513.   CalendarBorder   = CalendarBorder * PrintWidth
  2514.   CalendarShadow   = CalendarShadow * PrintWidth
  2515.   PrintWidth       = PrintWidth - 2 * CalendarBorder - CalendarShadow
  2516.   PrintHeight      = PrintHeight - 2 * CalendarBorder - CalendarShadow
  2517.   Margin.Left      = Margin.Left + CalendarBorder
  2518.  
  2519.   BoxWidth         = PrintWidth/7
  2520.   CalRight         = Margin.Left + BoxWidth * 7
  2521.   TextArea         = TextArea * PrintHeight
  2522.   CalTop           = TextArea + Margin.Top + CalendarBorder
  2523.   BoxHeight        = (PrintHeight - TextArea)/5
  2524.   CRadius          = CornerRadius * min(BoxHeight, BoxWidth)
  2525.   CurveOffset      = DateOffset * BoxWidth + CRadius * .25
  2526.   DateOffset       = DateOffset * BoxWidth
  2527.   FSize.Date       = BoxHeight/HighlightRows * 72 * StretchDateH
  2528.   Width.Date       = Width.Date * StretchDateW / StretchDateH
  2529.   FSize.Highlight  = BoxHeight/AddEventRows * 72
  2530.   if App == 'FW' then FSize.Highlight = max(trunc(FSize.Highlight), 4)
  2531.   if App == 'FW' then FSize.Date = max(trunc(FSize.Date), 4)
  2532.   Height.Highlight = GetHeight(Highlight) * Leading/100
  2533.   Height.Date      = GetHeight(Date) * Leading/100
  2534.  
  2535.   FontInfo = compress(Font.Highlight''FSize.Highlight, '. /:')
  2536.   FontKnown.FontInfo = Highlight
  2537.  
  2538.   RowsThatFit      = trunc(BoxHeight / Height.Highlight + 0.05)
  2539.   Width.WidthOfDate1 = GetFontWidth(Date, '1')
  2540.   Width.WidthOfDate8 = GetFontWidth(Date, '8')
  2541.   VariablesSet = 1
  2542. return
  2543. /**/
  2544.  
  2545. /***//*** VarList () Subroutine ***/
  2546. VarList:
  2547.   AddEventRows             = 9
  2548.   AdjustDST                = 1
  2549.   AltColor.Date            = Black$
  2550.   AltColor.Extended        = Black$
  2551.   AltColor.Highlight       = Black$
  2552.   AltColor.HighlightH      = Black$
  2553.   AltColor.History         = Black$
  2554.   AltColor.Julian          = Black$
  2555.   AltColor.Random          = Black$
  2556.   AltColor.Sunrise         = Black$
  2557.   AltColor.Sunset          = Black$
  2558.   AltColor.WeekNumber      = Black$
  2559.   Background.AddEvent      = White$
  2560.   Background.CalShadow     = Black$
  2561.   Background.Highlight     = '<'Clear$'>'
  2562.   Background.HighlightH    = '<'Clear$'>'
  2563.   Background.MiniCal       = White$
  2564.   Background.MiniCalShadow = Black$
  2565.   Background.NoteBox       = '<'Clear$'>'
  2566.   Background.Standard      = '<'Clear$'>'
  2567.   Background.Weekend       = '<'Clear$'>'
  2568.   BelzierFactor            = .55
  2569.   Bold.MiniCal             = DefaultBold
  2570.   Bold.FYMiniCal           = DefaultBold
  2571.   CalendarBorder           = 0
  2572.   CalendarShadow           = 0
  2573.   CenterHistory            = 1
  2574.   CenterMiniDates          = 1
  2575.   CenterRandom             = 1
  2576.   Color.Sunday             = Black$
  2577.   Color.Monday             = Black$
  2578.   Color.Tuesday            = Black$
  2579.   Color.Wednesday          = Black$
  2580.   Color.Thursday           = Black$
  2581.   Color.Friday             = Black$
  2582.   Color.Saturday           = Black$
  2583.   Color.AddEvent           = Black$
  2584.   Color.Date               = Black$
  2585.   Color.Extended           = Black$
  2586.   Color.Header             = Black$
  2587.   Color.Highlight          = Black$
  2588.   Color.HighlightH         = Black$
  2589.   Color.History            = Black$
  2590.   Color.Julian             = Black$
  2591.   Color.MiniCal            = Black$
  2592.   Color.Moon               = Black$
  2593.   Color.NoteBox            = Black$
  2594.   Color.Random             = Black$
  2595.   Color.SubHeader          = Black$
  2596.   Color.Sunrise            = Black$
  2597.   Color.Sunset             = Black$
  2598.   Color.Weekday            = Black$
  2599.   Color.WeekNumber         = Black$
  2600.   CornerRadius             = 0
  2601.   DateOffset               = 2
  2602.   DoDailyColors            = 0
  2603.   DoDateBox                = 0
  2604.   DoExtended               = 1
  2605.   DoHide                   = 0
  2606.   DoHighlights             = 0
  2607.   DoHistory                = ''
  2608.   DoImages                 = 0
  2609.   DoJulian                 = ''
  2610.   DoJulianLeft             = ''
  2611.   DoMatchColors            = 0
  2612.   DoMiniCals               = 1
  2613.   DoNoteBox                = 0
  2614.   DoPhases                 = ''
  2615.   DoRandom                 = ''
  2616.   DoSunRise                = ''
  2617.   DoSunSet                 = ''
  2618.   DoTopExtraWk             = 0
  2619.   DoWeekNumber             = ''
  2620.   FinalView                = 75
  2621.   Font.Date                = DefaultFont
  2622.   Font.Extras              = DefaultFont
  2623.   Font.Header              = DefaultFont
  2624.   Font.Highlight           = DefaultFont
  2625.   Font.MiniCal             = DefaultFont
  2626.   Font.FYMiniCal           = DefaultFont
  2627.   Font.Weekday             = DefaultFont
  2628.   Font.SubHeader           = DefaultFont
  2629.   ForceBGUI                = 0
  2630.   GenMVars                 = 'Month.Month EnteredYear'
  2631.   GenYVars                 = 'EnteredYear'
  2632.   GfxApp                   = 'Visage'
  2633.   GfxAppPath               = ''
  2634.   HeaderLoc                = 9
  2635.   HeaderSize               = 50
  2636.   Header$                  = '%s %s'
  2637.   HeaderVars               = 'Month.Month Year'
  2638.   HelpTime                 = 4
  2639.   HighlightRows            = 9
  2640.   HostScreen               = ''
  2641.   LaunchM                  = ''
  2642.   LaunchY                  = ''
  2643.   Leading                  = 100
  2644.   Line.AddEvent            = Black$
  2645.   Line.CalBorder           = Black$
  2646.   Line.Extended            = Black$
  2647.   Line.Grid                = Black$
  2648.   Line.MiniCal             = Black$
  2649.   Line.NoteBox             = Black$
  2650.   MagnifyExtras            = 100
  2651.   Margin.Bottom            = 0
  2652.   Margin.Left              = 0
  2653.   Margin.Right             = 0
  2654.   Margin.Top               = 0
  2655.   MinHistoryWidth          = 70
  2656.   MinRandomWidth           = 70
  2657.   MinWidth                 = 80
  2658.   MaxImgHeight             = 75
  2659.   MaxImgWidth              = 75
  2660.   MiniCalHeight            = 60
  2661.   MiniCalSpacing           = 0.5
  2662.   MiniCalWidth             = 200
  2663.   MoonRadius               = 10
  2664.   Orientation              = 'Wide'
  2665.   PrefsName                = 'Default'
  2666.   ShadowType               = 'P'
  2667.   ShiftLMini               = 0
  2668.   ShiftRMini               = 0
  2669.   StartWeek                = 0
  2670.   StretchDateH             = 100
  2671.   StretchDateW             = 100
  2672.   SubHeaderLoc             = 0
  2673.   SubHeaderSize            = 0
  2674.   SubHeader$               = ''
  2675.   SubHeaderVars            = ''
  2676.   SunCalcPath              = ''
  2677.   Text.Julian              = ''
  2678.   Text.Sunrise             = ''
  2679.   Text.Sunset              = ''
  2680.   Text.WeekNumber          = ''
  2681.   TextAdj                  = 77
  2682.   TTextArea                = 15
  2683.   WeekdaySize              = 50
  2684.   WTextArea                = 20
  2685. return
  2686. /**/
  2687.  
  2688.